From 9a3ea60476baccdf49d0bd7c4839b00b6b52627f Mon Sep 17 00:00:00 2001 From: Kevin F Date: Thu, 19 Nov 2020 23:39:49 +0100 Subject: [PATCH] Add automated Versioning and release note creation (Issue #44). --- RELEASE_NOTES.md | 17 +- build.fsx | 276 ++++++++++++++++++++++-- paket.dependencies | 2 + paket.lock | 16 +- src/Client/Api.fs | 11 +- src/Client/Messages.fs | 3 + src/Client/Model.fs | 2 + src/Client/Update.fs | 45 ++++ src/Client/Version.fs | 2 +- src/Client/Views/BaseView.fs | 4 +- src/Client/Views/InfoView.fs | 6 +- src/Server/Docs/DocsAnnotationAPIvs1.fs | 160 +------------- src/Server/Docs/DocsFunctions.fs | 150 +++++++++++++ src/Server/Docs/DocsServiceAPIvs1.fs | 33 +++ src/Server/Server.fs | 32 ++- src/Server/Server.fsproj | 3 + src/Server/Version.fs | 13 ++ src/Shared/Shared.fs | 11 +- 18 files changed, 602 insertions(+), 184 deletions(-) create mode 100644 src/Server/Docs/DocsFunctions.fs create mode 100644 src/Server/Docs/DocsServiceAPIvs1.fs create mode 100644 src/Server/Version.fs diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 33102256..2c942227 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,16 +1,23 @@ -### v0.1.1 - 2020-11-18 -* Rough feature set: +### 0.1.2+99a427 (Released 19.11.2020) +* Additions: + * #199a427 + * Add automated Versioning and release note creation (Issue #44). + * Update Sql dump + +### 0.1.1+7c567fd (Released 2020-11-18) +* Additions: + * #7c567fd * Allow for multiples of the same column. * Implement basic validation system for current worksheet. (WIP) * Add info page with social media links and contact. * Add extensive api docs. - * Bug fixes: - * Unit Term Search broke due to a change in naming conventions in the stored procedures. Fixed it! +* Bugfixes: + * Unit Term Search broke due to a change in naming conventions in the stored procedures. Fixed it! ### v0.1-beta - 2020-11-05 * Release of [Minimal POC milestone](https://github.com/nfdi4plants/Swate/milestone/1?closed=1). Rough feature set: * Update advanced term search to use stored procedure introduced in 0.0.2-alpha. - * Bug fixes: + * Bugfixes: * Responsive design should now render immediatly upon window size change * Add-in should not reload after navigating to a new tab for the first time. * Term search input field no longer looses focus after clicking into it. diff --git a/build.fsx b/build.fsx index abe9d414..35a02427 100644 --- a/build.fsx +++ b/build.fsx @@ -8,6 +8,7 @@ open Fake open Fake.Core open Fake.DotNet open Fake.IO +open Fake.Tools.Git open Farmer open Farmer.Builders @@ -21,8 +22,6 @@ let clientDeployPath = Path.combine clientPath "deploy" let sharedTestsPath = Path.getFullName "./tests/Shared" let serverTestsPath = Path.getFullName "./tests/Server" -let release = ReleaseNotes.load "RELEASE_NOTES.md" - let platformTool tool winTool = let tool = if Environment.isUnix then tool else winTool match ProcessUtils.tryFindFileOnPath tool with @@ -39,6 +38,8 @@ let npmTool = platformTool "npm" "npm.cmd" let npxTool = platformTool "npx" "npx.cmd" let dockerComposeTool = platformTool "docker-compose" "docker-compose.exe" +let currentDateString = System.DateTime.Now.ToShortDateString() + let runTool cmd args workingDir = let arguments = args |> String.split ' ' |> Arguments.OfArgs Command.RawCommand (cmd, arguments) @@ -93,6 +94,7 @@ Target.create "InstallClient" (fun _ -> ) Target.create "Build" (fun _ -> + let release = ReleaseNotes.load "RELEASE_NOTES.md" runDotNet "build" serverPath Shell.regexReplaceInFileWithEncoding "let app = \".+\"" @@ -149,7 +151,7 @@ Target.create "OfficeDebug" (fun _ -> runTool dockerComposeTool "-f .db\docker-compose.yml up" __SOURCE_DIRECTORY__ } - let vsCodeSession = Environment.hasEnvironVar "vsCodeSession" + //let vsCodeSession = Environment.hasEnvironVar "vsCodeSession" let safeClientOnly = Environment.hasEnvironVar "safeClientOnly" let tasks = @@ -245,18 +247,265 @@ Target.create "CreateDevCerts" (fun _ -> let psi = new System.Diagnostics.ProcessStartInfo(FileName = certPath, UseShellExecute = true) System.Diagnostics.Process.Start(psi) |> ignore - ) -//Target.create "Bundle" (fun _ -> -// let serverDir = Path.combine deployDir "Server" -// let clientDir = Path.combine deployDir "Client" -// let publicDir = Path.combine clientDir "public" -// let publishArgs = sprintf "publish -c Release -o \"%s\"" serverDir -// runDotNet publishArgs serverPath +type SemVerRelease = +| Major +| Minor +| Patch +| WIP + +type ReleaseNotesDescriptors = +| Additions +| Deletions +| Bugfixes + + /// | Additions -> "Additions:" | Deletions -> "Deletions:" | Bugfixes -> "Bugfixes:" + member this.toString = + match this with + | Additions -> "Additions:" + | Deletions -> "Deletions:" + | Bugfixes -> "Bugfixes:" + + static member DescriptorList = + [Additions.toString; Deletions.toString; Bugfixes.toString] + +let createNewSemVer (semVerReleaseType:SemVerRelease) (newestCommitHash:string) (previousSemVer:SemVerInfo)= + match semVerReleaseType with + | Major -> + sprintf "%i.0.0+%s" (previousSemVer.Major+1u) newestCommitHash.[1..] + | Minor -> + sprintf "%i.%i.0+%s" (previousSemVer.Major) (previousSemVer.Minor+1u) newestCommitHash.[1..] + | Patch -> + sprintf "%i.%i.%i+%s" (previousSemVer.Major) (previousSemVer.Minor) (previousSemVer.Patch+1u) newestCommitHash.[1..] + | WIP -> + sprintf "%i.%i.%i+%s" (previousSemVer.Major) (previousSemVer.Minor) (previousSemVer.Patch) newestCommitHash.[1..] + +// This is later used to try and sort the commit messages to the three fields additions, bugs and deletions. +let rec sortCommitsByKeyWords (all:string list) (additions:string list) (deletions:string list) (bugs:string list) = + let bugKeyWords = [|"bug"; "problem"|] |> Array.map String.toLower + let deleteKeyWords = [|"delete"; "remove"|] |> Array.map String.toLower + let isHeadBugKeyWord (head:string) = Array.exists (fun x -> x = head.ToLower()) bugKeyWords + let isHeadDeleteKeyWord (head:string) = Array.exists (fun x -> x = head.ToLower()) deleteKeyWords + match all with + | head::rest when isHeadBugKeyWord head + -> sortCommitsByKeyWords rest additions deletions (head::bugs) + | head::rest when isHeadDeleteKeyWord head + -> sortCommitsByKeyWords rest additions (head::deletions) bugs + | head::rest -> sortCommitsByKeyWords rest (head::additions) deletions bugs + | head::[] when isHeadBugKeyWord head + -> additions, deletions, (head::bugs) + | head::[] when isHeadDeleteKeyWord head + -> additions, (head::deletions), bugs + | head::[] + -> (head::additions), deletions, bugs + | [] + -> additions, deletions, bugs + |> fun (x,y,z) -> List.rev x, List.rev y, List.rev z + + +let splitPreviousReleaseNotes releaseNotes = + let addOpt = releaseNotes |> List.tryFindIndex (fun x -> x = Additions.toString) + let deleteOpt = releaseNotes |> List.tryFindIndex (fun x -> x = Deletions.toString) + let bugOpt = releaseNotes |> List.tryFindIndex (fun x -> x = Bugfixes.toString) + let indList = [addOpt,Additions;deleteOpt,Deletions;bugOpt,Bugfixes] |> List.choose (fun (x,y) -> if x.IsSome then Some (x.Value, y) else None) + let addedDescriptors = + releaseNotes + |> List.mapi (fun i x -> + let descriptor = indList |> List.tryFindBack (fun (descInd,_) -> descInd <= i && ReleaseNotesDescriptors.DescriptorList |> List.contains x |> not) + if descriptor.IsNone then None else Some (snd descriptor.Value,x) + ) + let findCommitsByDescriptor descriptor (commitOptionList:(ReleaseNotesDescriptors*string) option list) = + commitOptionList + |> List.choose (fun x -> + if x.IsSome && fst x.Value = descriptor then Some (snd x.Value) else None + ) + |> List.map (fun x -> sprintf " * %s" x) + let prevAdditions = + findCommitsByDescriptor Additions addedDescriptors + // REMOVE this line as soon as parsing of semver metadata is fixed. + |> List.filter (fun x -> x.StartsWith " * #" |> not) + let prevDeletions = findCommitsByDescriptor Deletions addedDescriptors + let prevBugs = findCommitsByDescriptor Bugfixes addedDescriptors + prevAdditions, prevDeletions, prevBugs + +Target.create "IsExistingReleaseNotes" (fun _ -> + let isExisting = Fake.IO.File.exists "RELEASE_NOTES.md" + if isExisting = false then + Fake.IO.File.create "RELEASE_NOTES.md" + Fake.IO.File.write + true + "RELEASE_NOTES.md" + [ + sprintf "### 0.0.0 (Released %s)" (currentDateString) + "* Additions:" + " * Initial set up for RELEASE_Notes.md" + ] + Trace.traceImportant "RELEASE_Notes.md created" + else + Trace.trace "RELEASE_Notes.md found" +) + +Target.create "Release" (fun config -> + + let semVer = + let opt = + config.Context.Arguments + |> List.tryFind (fun x -> x.StartsWith "semver:") + match opt with + | Some "semver:major"| Some "semver:Major" -> + Major + | Some "semver:minor"| Some "semver:Minor" -> + Minor + | Some "semver:Patch"| Some "semver:patch" -> + Patch + | Some "semver:wip"| Some "semver:WIP" -> + WIP + | Some x -> + Trace.traceError (sprintf "Unrecognized argument: \"%s\". Default to \"semver:wip\"." x) + WIP + | None -> WIP + + let nOfLastCommitsToCheck = + let opt = + config.Context.Arguments + |> List.tryFind (fun x -> x.StartsWith "n:") + if opt.IsSome then opt.Value.Replace("n:","") else "30" + + let prevReleaseNotes = + Fake.IO.File.read "RELEASE_NOTES.md" + + let release = ReleaseNotes.load "RELEASE_NOTES.md" + + Trace.trace (sprintf "%A" release.Notes) + + // REMOVE this line as soon as parsing of semver metadata is fixed. + // This should be in release.SemVer.MetaData + let (tryFindPreviousReleaseCommitHash: string option) = + release.Notes + |> List.tryFind (fun x -> x.TrimStart([|' ';'*'|]).StartsWith "#") + + if tryFindPreviousReleaseCommitHash.IsSome then + Trace.trace (sprintf "Found PreviousCommit: %s" tryFindPreviousReleaseCommitHash.Value) + else + Trace.traceError "Did not find previous Commit!" + + //https://git-scm.com/book/en/v2/Git-Basics-Viewing-the-Commit-History#pretty_format + let allGitCommits = + Fake.Tools.Git.CommandHelper.runGitCommand "" ("log -" + nOfLastCommitsToCheck + " --pretty=format:\"%h;%s\"" ) + + let cutCommitsAtPreviousReleaseCommit = + allGitCommits + |> fun (_,gitCommits,_) -> + if tryFindPreviousReleaseCommitHash.IsSome then + let indOpt = + gitCommits |> List.tryFindIndex (fun y -> y.Contains tryFindPreviousReleaseCommitHash.Value.[1..]) + let ind = + if indOpt.IsSome then + indOpt.Value + else + failwithf + "Could not find last version git hash: %s in the last %s commits. + You can increase the number of searched commits by passing a argument + as such \"dotnet fake build -t release n:50\"" + tryFindPreviousReleaseCommitHash.Value nOfLastCommitsToCheck + gitCommits + |> List.take (ind) + else + gitCommits + + Trace.trace "Update RELEASE_NOTES.md" + + let writeNewReleaseNotes = + + let commitNoteArr = cutCommitsAtPreviousReleaseCommit |> Array.ofList |> Array.map (fun x -> x.Split([|";"|],StringSplitOptions.None)) + // REMOVE this line as soon as parsing of semver metadata is fixed. + // This should be in release.SemVer.MetaData + let latestCommitHash = + let newCommit = if tryFindPreviousReleaseCommitHash.IsSome then tryFindPreviousReleaseCommitHash.Value else "" + if Array.isEmpty commitNoteArr then newCommit else sprintf "#%s" commitNoteArr.[0].[0] + let newSemVer = + createNewSemVer semVer latestCommitHash.[1..] release.SemVer + /// This will be used to directly create the release notes + let formattedCommitNoteList = + commitNoteArr + |> Array.map (fun x -> + sprintf " * %s" x.[1] + ) + |> List.ofArray + let additions, deletions, bugs = sortCommitsByKeyWords formattedCommitNoteList [] [] [] + + let newNotes = + if semVer <> WIP then + [ + sprintf "### %s (Released %s)" newSemVer currentDateString + if List.isEmpty additions |> not then + "* Additions:" + // REMOVE this line as soon as parsing of semver metadata is fixed. + sprintf " * %s" latestCommitHash + yield! additions + if List.isEmpty deletions |> not then + "* Deletions:" + yield! deletions + if List.isEmpty bugs |> not then + "* Bugfixes:" + yield! bugs + "" + yield! prevReleaseNotes + ] + else + let prevAdditions, prevDeletions, prevBugs = + splitPreviousReleaseNotes release.Notes + let appendAdditions, appendDeletions, appendBugfixes = + additions@prevAdditions,deletions@prevDeletions,bugs@prevBugs + let skipPrevVersionOfReleaseNotes = + let findInd = + prevReleaseNotes + |> Seq.indexed + |> Seq.choose (fun (i,x) -> if x.StartsWith "###" then Some i else None) + |> Seq.skip 1 + if Seq.isEmpty findInd then 0 else Seq.head findInd + [ + sprintf "### %s (Released %s)" newSemVer currentDateString + if List.isEmpty appendAdditions |> not then + "* Additions:" + // REMOVE this line as soon as parsing of semver metadata is fixed. + sprintf " * %s" latestCommitHash + yield! appendAdditions + if List.isEmpty appendDeletions |> not then + "* Deletions:" + yield! appendDeletions + if List.isEmpty appendBugfixes |> not then + "* Bugfixes:" + yield! appendBugfixes + "" + yield! (Seq.skip skipPrevVersionOfReleaseNotes prevReleaseNotes) + ] + + + Fake.IO.File.write + false + "RELEASE_NOTES.md" + newNotes + + writeNewReleaseNotes + + Trace.trace "Update RELEASE_NOTES.md done!" + + Trace.trace "Update Version.fs" + + let releaseDate = + if release.Date.IsSome then release.Date.Value.ToShortDateString() else "WIP" + + Fake.DotNet.AssemblyInfoFile.createFSharp "src/Server/Version.fs" + [ Fake.DotNet.AssemblyInfo.Title "SWATE" + Fake.DotNet.AssemblyInfo.Version release.AssemblyVersion + Fake.DotNet.AssemblyInfo.Metadata ("ReleaseDate",releaseDate) + //Fake.DotNet.AssemblyInfo.FileVersion release.AssemblyVersion + ] -// Shell.copyDir publicDir clientDeployPath FileFilter.allFiles -//) + Trace.trace "Update Version.fs done!" +) Target.create "Bundle" (fun _ -> runDotNet (sprintf "publish -c Release -o \"%s\"" deployDir) serverPath @@ -303,6 +552,9 @@ open Fake.Core.TargetOperators ==> "InstallClient" ==> "OfficeDebug" +"IsExistingReleaseNotes" + ==> "Release" + "InstallOfficeAddinTooling" ==> "WebpackConfigSetup" ==> "LocalConnectionStringSetup" diff --git a/paket.dependencies b/paket.dependencies index 16794b04..00278665 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -35,6 +35,8 @@ group Build framework: netstandard2.0 storage: none +nuget Fake.DotNet.AssemblyInfoFile 5.20.3 +nuget Fake.Tools.Git 5.20.3 nuget FSharp.Core nuget Fake.Core.ReleaseNotes nuget Fake.Core.Target diff --git a/paket.lock b/paket.lock index 61637335..49e03cb9 100644 --- a/paket.lock +++ b/paket.lock @@ -583,7 +583,7 @@ NUGET System.Threading.Tasks.Extensions (>= 4.4) System.ValueTuple (>= 4.4) -GROUP build +GROUP Build STORAGE: NONE RESTRICTION: == netstandard2.0 NUGET @@ -637,6 +637,12 @@ NUGET Fake.Core.Xml (5.20.3) Fake.Core.String (>= 5.20.3) FSharp.Core (>= 4.7.2) + Fake.DotNet.AssemblyInfoFile (5.20.3) + Fake.Core.Environment (>= 5.20.3) + Fake.Core.String (>= 5.20.3) + Fake.Core.Trace (>= 5.20.3) + Fake.IO.FileSystem (>= 5.20.3) + FSharp.Core (>= 4.7.2) Fake.DotNet.Cli (5.20.3) Fake.Core.Environment (>= 5.20.3) Fake.Core.Process (>= 5.20.3) @@ -676,6 +682,14 @@ NUGET Fake.Net.Http (5.20.3) Fake.Core.Trace (>= 5.20.3) FSharp.Core (>= 4.7.2) + Fake.Tools.Git (5.20.3) + Fake.Core.Environment (>= 5.20.3) + Fake.Core.Process (>= 5.20.3) + Fake.Core.SemVer (>= 5.20.3) + Fake.Core.String (>= 5.20.3) + Fake.Core.Trace (>= 5.20.3) + Fake.IO.FileSystem (>= 5.20.3) + FSharp.Core (>= 4.7.2) Farmer (1.1.1) FSharp.Core (>= 4.7.1) Newtonsoft.Json (>= 12.0.2) diff --git a/src/Client/Api.fs b/src/Client/Api.fs index 6114ffb1..e43c021c 100644 --- a/src/Client/Api.fs +++ b/src/Client/Api.fs @@ -5,6 +5,11 @@ open Fable.Remoting.Client /// A proxy you can use to talk to server directly let api : IAnnotatorAPIv1 = - Remoting.createApi() - |> Remoting.withRouteBuilder Route.builder - |> Remoting.buildProxy \ No newline at end of file + Remoting.createApi() + |> Remoting.withRouteBuilder Route.builder + |> Remoting.buildProxy + +let serviceApi : IServiceAPIv1 = + Remoting.createApi() + |> Remoting.withRouteBuilder Route.builder + |> Remoting.buildProxy \ No newline at end of file diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index a1e53978..3828bff3 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -57,6 +57,7 @@ type ApiRequestMsg = | GetNewUnitTermSuggestions of string | GetNewAdvancedTermSearchResults of AdvancedTermSearchOptions | FetchAllOntologies + | GetAppVersion type ApiResponseMsg = | TermSuggestionResponse of DbDomain.Term [] @@ -64,6 +65,7 @@ type ApiResponseMsg = | BuildingBlockNameSuggestionsResponse of DbDomain.Term [] | UnitTermSuggestionResponse of DbDomain.Term [] | FetchAllOntologiesResponse of DbDomain.Ontology [] + | GetAppVersionResponse of string type ApiMsg = | Request of ApiRequestMsg @@ -77,6 +79,7 @@ type StyleChangeMsg = type PersistentStorageMsg = | NewSearchableOntologies of DbDomain.Ontology [] + | UpdateAppVersion of string type FilePickerMsg = | NewFilesLoaded of string list diff --git a/src/Client/Model.fs b/src/Client/Model.fs index af53180e..4519cd34 100644 --- a/src/Client/Model.fs +++ b/src/Client/Model.fs @@ -131,10 +131,12 @@ type DevState = { type PersistentStorageState = { SearchableOntologies : (Set*DbDomain.Ontology) [] + AppVersion : string HasOntologiesLoaded : bool } with static member init () = { SearchableOntologies = [||] + AppVersion = "" HasOntologiesLoaded = false } diff --git a/src/Client/Update.fs b/src/Client/Update.fs index 325e0b2e..8982ba5f 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -69,6 +69,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel let cmd = Cmd.batch [ + Cmd.ofMsg (GetAppVersion |> Request |> Api) Cmd.ofMsg (FetchAllOntologies |> Request |> Api) Cmd.OfPromise.either OfficeInterop.checkIfAnnotationTableIsPresent @@ -512,6 +513,26 @@ let handleApiRequestMsg (reqMsg: ApiRequestMsg) (currentState: ApiState) : ApiSt () (FetchAllOntologiesResponse >> Response >> Api) (ApiError >> Api) + | GetAppVersion -> + let currentCall = { + FunctionName = "getAppVersion" + Status = Pending + } + + let nextState = { + currentState with + currentCall = currentCall + } + + let cmd = + Cmd.OfAsync.either + Api.serviceApi.getAppVersion + () + (GetAppVersionResponse >> Response >> Api) + (ApiError >> Api) + + nextState, cmd + let handleApiResponseMsg (resMsg: ApiResponseMsg) (currentState: ApiState) : ApiState * Cmd = @@ -605,6 +626,24 @@ let handleApiResponseMsg (resMsg: ApiResponseMsg) (currentState: ApiState) : Api onts |> NewSearchableOntologies |> PersistentStorage |> Cmd.ofMsg ] + nextState, cmds + | GetAppVersionResponse appVersion -> + let finishedCall = { + currentState.currentCall with + Status = Successfull + } + + let nextState = { + currentState with + currentCall = noCall + callHistory = finishedCall::currentState.callHistory + } + + let cmds = Cmd.batch [ + ("Debug",sprintf "[ApiSuccess]: Call %s successfull." finishedCall.FunctionName) |> ApiSuccess |> Api |> Cmd.ofMsg + appVersion |> UpdateAppVersion |> PersistentStorage |> Cmd.ofMsg + ] + nextState, cmds let handleApiMsg (apiMsg:ApiMsg) (currentState:ApiState) : ApiState * Cmd = @@ -643,6 +682,12 @@ let handlePersistenStorageMsg (persistentStorageMsg: PersistentStorageMsg) (curr } nextState,Cmd.none + | UpdateAppVersion appVersion -> + let nextState = { + currentState with + AppVersion = appVersion + } + nextState,Cmd.none let handleStyleChangeMsg (styleChangeMsg:StyleChangeMsg) (currentState:SiteStyleState) : SiteStyleState * Cmd = match styleChangeMsg with diff --git a/src/Client/Version.fs b/src/Client/Version.fs index 5faeffdb..61ba1558 100644 --- a/src/Client/Version.fs +++ b/src/Client/Version.fs @@ -1,5 +1,5 @@ module Version +/// This is the base SAFE stack version used for this app let template = "1.22.4" -let app = "v0.1.1" diff --git a/src/Client/Views/BaseView.fs b/src/Client/Views/BaseView.fs index 1f34c032..df5e8bc5 100644 --- a/src/Client/Views/BaseView.fs +++ b/src/Client/Views/BaseView.fs @@ -41,10 +41,10 @@ let createNavigationTab (pageLink: Routing.Route) (model:Model) (dispatch:Msg-> ] ] -let footerContentStatic model dispatch = +let footerContentStatic (model:Model) dispatch = div [][ str "Swate Release Version " - a [Href "https://github.com/nfdi4plants/Swate/releases"][str (Version.app)] + a [Href "https://github.com/nfdi4plants/Swate/releases"][str model.PersistentStorageState.AppVersion] ] open System.Text.RegularExpressions diff --git a/src/Client/Views/InfoView.fs b/src/Client/Views/InfoView.fs index 04ba97be..4d627451 100644 --- a/src/Client/Views/InfoView.fs +++ b/src/Client/Views/InfoView.fs @@ -137,8 +137,10 @@ let infoComponent (model : Model) (dispatch : Msg -> unit) = div [Style [Color model.SiteStyleState.ColorMode.Text; Margin "0 auto"; MaxWidth "80%"]][ div [Class "myflexText"][ - str "To make it easier for developers to start working with Swate, we provide a documentation of our APIs. These can be viewed under this " - a [Href Shared.URLs.DocsApiUrl; Target "_Blank"][str "link"] + str "To make it easier for developers to start working with Swate, we provide a documentation of our APIs. These can be viewed " + a [Href Shared.URLs.DocsApiUrl; Target "_Blank"][str "here"] + str " and " + a [Href Shared.URLs.DocsApiUrl2; Target "_Blank"][str "here"] str "." ] ] diff --git a/src/Server/Docs/DocsAnnotationAPIvs1.fs b/src/Server/Docs/DocsAnnotationAPIvs1.fs index 3cb38307..f333cf0f 100644 --- a/src/Server/Docs/DocsAnnotationAPIvs1.fs +++ b/src/Server/Docs/DocsAnnotationAPIvs1.fs @@ -9,148 +9,7 @@ open Shared.DbDomain open Fable.Remoting.Server open Fable.Remoting.Giraffe -type ParameterType = -| ParamInteger -| ParamFloat -| ParamString -| ParamBoolean -| ParamUnit -| ParamDateTime -| ParamArray of ParameterType -| ParamOption of ParameterType -| ParamRecordType of Parameter [] - - member this.toString = - match this with - | ParamInteger -> "Integer" - | ParamFloat -> "Float" - | ParamString -> "String" - | ParamBoolean -> "Boolean" - | ParamUnit -> "Unit" - | ParamDateTime -> "DateTime" - | ParamArray param -> sprintf "[ %s ]" param.toString - | ParamOption param -> sprintf "%s option" param.toString - | ParamRecordType paramArr -> Parameter.arrToString paramArr true - -and Parameter = { - Name : string - Type : ParameterType - Desc : string -} - with - /// isEnd defines if the single Parameter will be closed with a ',' or not. If isEnd = true then no comma, else comma. - static member singleToString (param:Parameter) isEnd = - sprintf - " -
//%s
-
%s : %s%s
- " - param.Desc - param.Name - param.Type.toString - (if isEnd then "" else ",") - - member this.toString = - Parameter.singleToString this true - - /// isRecordType defines if the Parameter array will be closed with a '[]' or '{}'. If isRecordType = true then '{}', else '[]'. - static member arrToString (paramArr:Parameter []) isRecordType = - let endInd = paramArr.Length-1 - let singleStrings = - paramArr - |> Array.mapi (fun i x -> - let isEnd = i = endInd - Parameter.singleToString x isEnd - ) - String.concat "" singleStrings - |> fun x -> - if isRecordType then - sprintf - " - {
-
%s
- }" - x - else - sprintf - " - [
-
%s
- ]" - x - - static member create name paramType desc = - { - Name = name - Type = paramType - Desc = desc - } - -module PredefinedParams = - - let dbDomainTerm = - let dbdomaniTermParamArr = [| - Parameter.create "ID" ParamInteger "" - Parameter.create "OntologyId" ParamInteger "" - Parameter.create "Accession" ParamString "" - Parameter.create "Name" ParamString "" - Parameter.create "Definition" ParamString "" - Parameter.create "XRefValueType" (ParamOption ParamString) "" - Parameter.create "IsObsolete" ParamBoolean "" - |] - dbdomaniTermParamArr - |> ParamRecordType - - let dbDomainOntology = - let dbdomaniOntologyParamArr = [| - Parameter.create "ID" ParamInteger "" - Parameter.create "Name" ParamString "" - Parameter.create "CurrentVersion" ParamString "" - Parameter.create "Definition" ParamString "" - Parameter.create "DateCreated" ParamDateTime "" - Parameter.create "UserID" ParamString "" - |] - dbdomaniOntologyParamArr - |> ParamRecordType - - let unitOntology:DbDomain.Ontology = { - ID = 1L - Name = "uo" - CurrentVersion = "releases/2020-03-10" - Definition = "Unit Ontology" - DateCreated = System.DateTime(2014,9,4) //"2014-09-04 00:00:00.000000" - UserID = "gkoutos" - } - - -let createDocumentationDescription functionDesc usageDesc (paramArr:Parameter [] option) resultDesc (resultType:Parameter) = - let prepParams = - if paramArr.IsSome then Parameter.arrToString paramArr.Value false else "No parameters are passed." - - let prepResultParam = - resultType.toString - sprintf - " -
Function
-
%s
-
-
Usage
-
%s
-
-
Parameters
-
%s
-
-
Result
-
%s
-
-
ResultType
-
%s
- " - functionDesc - usageDesc - prepParams - resultDesc - prepResultParam +open DocsFunctions let annotatorDocsv1 = Docs.createFor() @@ -174,19 +33,18 @@ let annotatorApiDocsv1 = //////// annotatorDocsv1.route <@ fun api -> api.getTestString @> |> annotatorDocsv1.alias "Get Test String (getTestString)" - |> annotatorDocsv1.description + |> annotatorDocsv1.description ( createDocumentationDescription - "This is used during development to check documentation for fsharp option types." + "This is used during development to test documentation for fsharp." "" (Some [| - Parameter.create "StringOption" (ParamOption ParamString) "" + Parameter.create "TestParam" (ParamDateTime) "This Param will often change during development" |]) - "Returns a single string with a fixed value." - (Parameter.create "TestValue" ParamString "A single fixed integer value to test connectivity.") + "The result will contain the TestParam of some sort." + (Parameter.create "TestValue" ParamString "") ) - |> annotatorDocsv1.example <@ fun api -> api.getTestString (None) @> - |> annotatorDocsv1.example <@ fun api -> api.getTestString (Some "Hallo ich bin der TestString!") @> + |> annotatorDocsv1.example <@ fun api -> api.getTestString (System.DateTime(2020,11,17)) @> ///////////////////////////////////////////////////////////// Ontology related requests ///////////////////////////////////////////////////////////// //////// @@ -207,7 +65,7 @@ let annotatorApiDocsv1 = "Creates a DbDomain.Ontology from the given params and returns it." (Parameter.create "Ontology" PredefinedParams.dbDomainOntology "A database Ontology entry. This one is not from the database and is currently not created. ID is a set value for this version.") ) - |> annotatorDocsv1.example <@ fun api -> api.testOntologyInsert ("TO","releases/testdate","Test Ontology",System.DateTime(2020,11,17),"UserTestId") @> + |> annotatorDocsv1.example <@ fun api -> api.testOntologyInsert ("TO","releases/testdate","Test Ontology",PredefinedParams.test,"UserTestId") @> //////// annotatorDocsv1.route <@ fun api -> api.getAllOntologies @> @@ -223,7 +81,7 @@ let annotatorApiDocsv1 = "This function returns an array of all Database.Ontology entries in the form of DbDomain.Ontology []." (Parameter.create "Ontology []" dbDomainOntologyArr "Array of database Ontology entries.") ) - + |> annotatorDocsv1.example <@ fun api -> api.getAllOntologies () @> ///////////////////////////////////////////////////////////// Term related requests ///////////////////////////////////////////////////////////// //////// diff --git a/src/Server/Docs/DocsFunctions.fs b/src/Server/Docs/DocsFunctions.fs new file mode 100644 index 00000000..4190b9be --- /dev/null +++ b/src/Server/Docs/DocsFunctions.fs @@ -0,0 +1,150 @@ +module DocsFunctions + +open System + +open Shared + +type ParameterType = +| ParamInteger +| ParamFloat +| ParamString +| ParamBoolean +| ParamUnit +| ParamDateTime +| ParamArray of ParameterType +| ParamOption of ParameterType +| ParamRecordType of Parameter [] + + member this.toString = + match this with + | ParamInteger -> "Integer" + | ParamFloat -> "Float" + | ParamString -> "String" + | ParamBoolean -> "Boolean" + | ParamUnit -> "Unit" + | ParamDateTime -> "DateTime" + | ParamArray param -> sprintf "[ %s ]" param.toString + | ParamOption param -> sprintf "%s option" param.toString + | ParamRecordType paramArr -> Parameter.arrToString paramArr true + +and Parameter = { + Name : string + Type : ParameterType + Desc : string +} + with + /// isEnd defines if the single Parameter will be closed with a ',' or not. If isEnd = true then no comma, else comma. + static member singleToString (param:Parameter) isEnd = + sprintf + " +
//%s
+
%s : %s%s
+ " + param.Desc + param.Name + param.Type.toString + (if isEnd then "" else ",") + + member this.toString = + Parameter.singleToString this true + + /// isRecordType defines if the Parameter array will be closed with a '[]' or '{}'. If isRecordType = true then '{}', else '[]'. + static member arrToString (paramArr:Parameter []) isRecordType = + let endInd = paramArr.Length-1 + let singleStrings = + paramArr + |> Array.mapi (fun i x -> + let isEnd = i = endInd + Parameter.singleToString x isEnd + ) + String.concat "" singleStrings + |> fun x -> + if isRecordType then + sprintf + " + {
+
%s
+ }" + x + else + sprintf + " + [
+
%s
+ ]" + x + + static member create name paramType desc = + { + Name = name + Type = paramType + Desc = desc + } + +module PredefinedParams = + + let dbDomainTerm = + let dbdomaniTermParamArr = [| + Parameter.create "ID" ParamInteger "" + Parameter.create "OntologyId" ParamInteger "" + Parameter.create "Accession" ParamString "" + Parameter.create "Name" ParamString "" + Parameter.create "Definition" ParamString "" + Parameter.create "XRefValueType" (ParamOption ParamString) "" + Parameter.create "IsObsolete" ParamBoolean "" + |] + dbdomaniTermParamArr + |> ParamRecordType + + let dbDomainOntology = + let dbdomaniOntologyParamArr = [| + Parameter.create "ID" ParamInteger "" + Parameter.create "Name" ParamString "" + Parameter.create "CurrentVersion" ParamString "" + Parameter.create "Definition" ParamString "" + Parameter.create "DateCreated" ParamDateTime "" + Parameter.create "UserID" ParamString "" + |] + dbdomaniOntologyParamArr + |> ParamRecordType + + let unitOntology:DbDomain.Ontology = { + ID = 1L + Name = "uo" + CurrentVersion = "releases/2020-03-10" + Definition = "Unit Ontology" + DateCreated = System.DateTime(2014,9,4) //"2014-09-04 00:00:00.000000" + UserID = "gkoutos" + } + + let test = System.DateTime(2020,11,17) + + +let createDocumentationDescription functionDesc usageDesc (paramArr:Parameter [] option) resultDesc (resultType:Parameter) = + let prepParams = + if paramArr.IsSome then Parameter.arrToString paramArr.Value false else "No parameters are passed." + + let prepResultParam = + resultType.toString + sprintf + " +
Function
+
%s
+
+
Usage
+
%s
+
+
Parameters
+
%s
+
+
Result
+
%s
+
+
ResultType
+
%s
+ " + functionDesc + usageDesc + prepParams + resultDesc + prepResultParam \ No newline at end of file diff --git a/src/Server/Docs/DocsServiceAPIvs1.fs b/src/Server/Docs/DocsServiceAPIvs1.fs new file mode 100644 index 00000000..713f760f --- /dev/null +++ b/src/Server/Docs/DocsServiceAPIvs1.fs @@ -0,0 +1,33 @@ +module DocsServiceAPIvs1 + +open Shared +open Giraffe +open Saturn +open Shared +open Shared.DbDomain + +open Fable.Remoting.Server +open Fable.Remoting.Giraffe + +open DocsFunctions + +let serviceDocsv1 = Docs.createFor() + +let serviceApiDocsv1 = + Remoting.documentation (sprintf "Service API v1") [ + + ///////////////////////////////////////////////////////////// Development ///////////////////////////////////////////////////////////// + //////// + serviceDocsv1.route <@ fun api -> api.getAppVersion @> + |> serviceDocsv1.alias "Get App Version (getAppVersion)" + |> serviceDocsv1.description + ( + createDocumentationDescription + "This function is used to get a server site saved version string for the app." + "getAppVersion is executed during app initialisation and displayed in the footer." + None + "Returns the app version." + (Parameter.create "Version" ParamString "App Version") + ) + +] \ No newline at end of file diff --git a/src/Server/Server.fs b/src/Server/Server.fs index b094d75d..7167da62 100644 --- a/src/Server/Server.fs +++ b/src/Server/Server.fs @@ -27,6 +27,10 @@ let testApi = { getTestNumber = fun () -> async { return 42 } } +let serviceApi = { + getAppVersion = fun () -> async {return System.AssemblyVersionInformation.AssemblyVersion} +} + let annotatorApi cString = { //Development @@ -117,8 +121,18 @@ let testWebApp = ) |> Remoting.buildHttpHandler +let createIServiceAPIv1 = + Remoting.createApi() + |> Remoting.withRouteBuilder Route.builder + |> Remoting.fromValue serviceApi + |> Remoting.withDocs "/api/IServiceAPIv1/docs" DocsServiceAPIvs1.serviceApiDocsv1 + |> Remoting.withDiagnosticsLogger(printfn "%A") + |> Remoting.withErrorHandler( + (fun x y -> Propagate (sprintf "[SERVER SIDE ERROR]: %A @ %A" x y)) + ) + |> Remoting.buildHttpHandler -let createIAnnotatorApiWithVersion cString = +let createIAnnotatorApiv1 cString = Remoting.createApi() |> Remoting.withRouteBuilder Route.builder |> Remoting.fromValue (annotatorApi cString) @@ -130,18 +144,24 @@ let createIAnnotatorApiWithVersion cString = |> Remoting.buildHttpHandler let mainApiController = router { - forward @"/IAnnotatorAPI" (fun next ctx -> - // check if the version in the path exists for the api + + // + forward @"/IAnnotatorAPIv1" (fun next ctx -> let cString = - // user secret part for production let settings = ctx.GetService() settings.["Swate:ConnectionString"] - createIAnnotatorApiWithVersion cString next ctx + createIAnnotatorApiv1 cString next ctx ) + + // forward @"/ITestAPI" (fun next ctx -> - // check if the version in the path exists for the api testWebApp next ctx ) + + // + forward @"/IServiceAPIv1" (fun next ctx -> + createIServiceAPIv1 next ctx + ) } let topLevelRouter = router { diff --git a/src/Server/Server.fsproj b/src/Server/Server.fsproj index cdb70bc2..92fa0ece 100644 --- a/src/Server/Server.fsproj +++ b/src/Server/Server.fsproj @@ -7,7 +7,10 @@ + + + diff --git a/src/Server/Version.fs b/src/Server/Version.fs new file mode 100644 index 00000000..dab87a90 --- /dev/null +++ b/src/Server/Version.fs @@ -0,0 +1,13 @@ +// Auto-Generated by FAKE; do not edit +namespace System +open System.Reflection + +[] +[] +[] +do () + +module internal AssemblyVersionInformation = + let [] AssemblyTitle = "SWATE" + let [] AssemblyVersion = "0.1.2" + let [] AssemblyMetadata_ReleaseDate = "WIP" diff --git a/src/Shared/Shared.fs b/src/Shared/Shared.fs index df798715..d9c5af3d 100644 --- a/src/Shared/Shared.fs +++ b/src/Shared/Shared.fs @@ -11,6 +11,11 @@ module URLs = [] let DocsApiUrl = @"/api/IAnnotatorAPIv1/docs" + /// This will only be needed as long there is no documentation on where to find all api docs. + /// As soon as that link exists it will replace DocsApiUrl and DocsApiUrl2 + [] + let DocsApiUrl2 = @"/api/IServiceAPIv1/docs" + [] let CSBTwitterUrl = @"https://twitter.com/cs_biology" @@ -95,10 +100,14 @@ type ITestAPI = { getTestNumber : unit -> Async } +type IServiceAPIv1 = { + getAppVersion : unit -> Async +} + type IAnnotatorAPIv1 = { // Development getTestNumber : unit -> Async - getTestString : string option -> Async + getTestString : System.DateTime -> Async // Ontology related requests /// (name,version,definition,created,user) testOntologyInsert : (string*string*string*System.DateTime*string) -> Async