├── .gitignore
├── .paket
├── Paket.Restore.targets
├── paket.bootstrapper.exe
└── paket.targets
├── .vscode
└── tasks.json
├── LICENSE
├── README.md
├── build.cmd
├── build.fsx
├── fake.cmd
├── fake.sh
├── images
└── screen1.gif
├── paket.dependencies
├── paket.lock
└── src
├── SwaggerForFsharp.Giraffe
├── Analyzer.fs
├── Common.fs
├── Generator.fs
├── Swagger.fs
├── SwaggerForFsharp.Giraffe.fsproj
├── SwaggerUi.fs
├── paket.references
└── swagger-ui.zip
├── SwaggerForFsharp.sln
├── samples
└── SwaggerForFsharp.Giraffe.Sample
│ ├── Program.fs
│ ├── SwaggerForFsharp.Giraffe.Sample.fsproj
│ └── paket.references
└── tests
└── SwaggerForFsharp.Giraffe.Tests
├── SwaggerForFsharp.Giraffe.Tests.fsproj
├── SwaggerTests.fs
└── paket.references
/.gitignore:
--------------------------------------------------------------------------------
1 | ## Ignore Visual Studio temporary files, build results, and
2 | ## files generated by popular Visual Studio add-ons.
3 | ##
4 | ## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore
5 |
6 | # User-specific files
7 | *.suo
8 | *.user
9 | *.userosscache
10 | *.sln.docstates
11 |
12 | # User-specific files (MonoDevelop/Xamarin Studio)
13 | *.userprefs
14 |
15 | # Build results
16 | [Dd]ebug/
17 | [Dd]ebugPublic/
18 | [Rr]elease/
19 | [Rr]eleases/
20 | x64/
21 | x86/
22 | bld/
23 | [Bb]in/
24 | [Oo]bj/
25 | [Ll]og/
26 |
27 | # Visual Studio 2015/2017 cache/options directory
28 | .vs/
29 | # Uncomment if you have tasks that create the project's static files in wwwroot
30 | #wwwroot/
31 |
32 | # Visual Studio 2017 auto generated files
33 | Generated\ Files/
34 |
35 | # MSTest test Results
36 | [Tt]est[Rr]esult*/
37 | [Bb]uild[Ll]og.*
38 |
39 | # NUNIT
40 | *.VisualState.xml
41 | TestResult.xml
42 |
43 | # Build Results of an ATL Project
44 | [Dd]ebugPS/
45 | [Rr]eleasePS/
46 | dlldata.c
47 |
48 | # Benchmark Results
49 | BenchmarkDotNet.Artifacts/
50 |
51 | # .NET Core
52 | project.lock.json
53 | project.fragment.lock.json
54 | artifacts/
55 | **/Properties/launchSettings.json
56 |
57 | # StyleCop
58 | StyleCopReport.xml
59 |
60 | # Files built by Visual Studio
61 | *_i.c
62 | *_p.c
63 | *_i.h
64 | *.ilk
65 | *.meta
66 | *.obj
67 | *.iobj
68 | *.pch
69 | *.pdb
70 | *.ipdb
71 | *.pgc
72 | *.pgd
73 | *.rsp
74 | *.sbr
75 | *.tlb
76 | *.tli
77 | *.tlh
78 | *.tmp
79 | *.tmp_proj
80 | *.log
81 | *.vspscc
82 | *.vssscc
83 | .builds
84 | *.pidb
85 | *.svclog
86 | *.scc
87 |
88 | # Chutzpah Test files
89 | _Chutzpah*
90 |
91 | # Visual C++ cache files
92 | ipch/
93 | *.aps
94 | *.ncb
95 | *.opendb
96 | *.opensdf
97 | *.sdf
98 | *.cachefile
99 | *.VC.db
100 | *.VC.VC.opendb
101 |
102 | # Visual Studio profiler
103 | *.psess
104 | *.vsp
105 | *.vspx
106 | *.sap
107 |
108 | # Visual Studio Trace Files
109 | *.e2e
110 |
111 | # TFS 2012 Local Workspace
112 | $tf/
113 |
114 | # Guidance Automation Toolkit
115 | *.gpState
116 |
117 | # ReSharper is a .NET coding add-in
118 | _ReSharper*/
119 | *.[Rr]e[Ss]harper
120 | *.DotSettings.user
121 |
122 | # JustCode is a .NET coding add-in
123 | .JustCode
124 |
125 | # TeamCity is a build add-in
126 | _TeamCity*
127 |
128 | # DotCover is a Code Coverage Tool
129 | *.dotCover
130 |
131 | # AxoCover is a Code Coverage Tool
132 | .axoCover/*
133 | !.axoCover/settings.json
134 |
135 | # Visual Studio code coverage results
136 | *.coverage
137 | *.coveragexml
138 |
139 | # NCrunch
140 | _NCrunch_*
141 | .*crunch*.local.xml
142 | nCrunchTemp_*
143 |
144 | # MightyMoose
145 | *.mm.*
146 | AutoTest.Net/
147 |
148 | # Web workbench (sass)
149 | .sass-cache/
150 |
151 | # Installshield output folder
152 | [Ee]xpress/
153 |
154 | # DocProject is a documentation generator add-in
155 | DocProject/buildhelp/
156 | DocProject/Help/*.HxT
157 | DocProject/Help/*.HxC
158 | DocProject/Help/*.hhc
159 | DocProject/Help/*.hhk
160 | DocProject/Help/*.hhp
161 | DocProject/Help/Html2
162 | DocProject/Help/html
163 |
164 | # Click-Once directory
165 | publish/
166 |
167 | # Publish Web Output
168 | *.[Pp]ublish.xml
169 | *.azurePubxml
170 | # Note: Comment the next line if you want to checkin your web deploy settings,
171 | # but database connection strings (with potential passwords) will be unencrypted
172 | *.pubxml
173 | *.publishproj
174 |
175 | # Microsoft Azure Web App publish settings. Comment the next line if you want to
176 | # checkin your Azure Web App publish settings, but sensitive information contained
177 | # in these scripts will be unencrypted
178 | PublishScripts/
179 |
180 | # NuGet Packages
181 | *.nupkg
182 | # The packages folder can be ignored because of Package Restore
183 | **/[Pp]ackages/*
184 | # except build/, which is used as an MSBuild target.
185 | !**/[Pp]ackages/build/
186 | # Uncomment if necessary however generally it will be regenerated when needed
187 | #!**/[Pp]ackages/repositories.config
188 | # NuGet v3's project.json files produces more ignorable files
189 | *.nuget.props
190 | *.nuget.targets
191 |
192 | # Microsoft Azure Build Output
193 | csx/
194 | *.build.csdef
195 |
196 | # Microsoft Azure Emulator
197 | ecf/
198 | rcf/
199 |
200 | # Windows Store app package directories and files
201 | AppPackages/
202 | BundleArtifacts/
203 | Package.StoreAssociation.xml
204 | _pkginfo.txt
205 | *.appx
206 |
207 | # Visual Studio cache files
208 | # files ending in .cache can be ignored
209 | *.[Cc]ache
210 | # but keep track of directories ending in .cache
211 | !*.[Cc]ache/
212 |
213 | # Others
214 | ClientBin/
215 | ~$*
216 | *~
217 | *.dbmdl
218 | *.dbproj.schemaview
219 | *.jfm
220 | *.pfx
221 | *.publishsettings
222 | orleans.codegen.cs
223 |
224 | # Including strong name files can present a security risk
225 | # (https://github.com/github/gitignore/pull/2483#issue-259490424)
226 | #*.snk
227 |
228 | # Since there are multiple workflows, uncomment next line to ignore bower_components
229 | # (https://github.com/github/gitignore/pull/1529#issuecomment-104372622)
230 | #bower_components/
231 |
232 | # RIA/Silverlight projects
233 | Generated_Code/
234 |
235 | # Backup & report files from converting an old project file
236 | # to a newer Visual Studio version. Backup files are not needed,
237 | # because we have git ;-)
238 | _UpgradeReport_Files/
239 | Backup*/
240 | UpgradeLog*.XML
241 | UpgradeLog*.htm
242 | ServiceFabricBackup/
243 | *.rptproj.bak
244 |
245 | # SQL Server files
246 | *.mdf
247 | *.ldf
248 | *.ndf
249 |
250 | # Business Intelligence projects
251 | *.rdl.data
252 | *.bim.layout
253 | *.bim_*.settings
254 | *.rptproj.rsuser
255 |
256 | # Microsoft Fakes
257 | FakesAssemblies/
258 |
259 | # GhostDoc plugin setting file
260 | *.GhostDoc.xml
261 |
262 | # Node.js Tools for Visual Studio
263 | .ntvs_analysis.dat
264 | node_modules/
265 |
266 | # Visual Studio 6 build log
267 | *.plg
268 |
269 | # Visual Studio 6 workspace options file
270 | *.opt
271 |
272 | # Visual Studio 6 auto-generated workspace file (contains which files were open etc.)
273 | *.vbw
274 |
275 | # Visual Studio LightSwitch build output
276 | **/*.HTMLClient/GeneratedArtifacts
277 | **/*.DesktopClient/GeneratedArtifacts
278 | **/*.DesktopClient/ModelManifest.xml
279 | **/*.Server/GeneratedArtifacts
280 | **/*.Server/ModelManifest.xml
281 | _Pvt_Extensions
282 |
283 | # Paket dependency manager
284 | .paket/paket.exe
285 | paket-files/
286 |
287 | # FAKE - F# Make
288 | .fake/
289 |
290 | # JetBrains Rider
291 | .idea/
292 | *.sln.iml
293 |
294 | # CodeRush
295 | .cr/
296 |
297 | # Python Tools for Visual Studio (PTVS)
298 | __pycache__/
299 | *.pyc
300 |
301 | # Cake - Uncomment if you are using it
302 | # tools/**
303 | # !tools/packages.config
304 |
305 | # Tabs Studio
306 | *.tss
307 |
308 | # Telerik's JustMock configuration file
309 | *.jmconfig
310 |
311 | # BizTalk build output
312 | *.btp.cs
313 | *.btm.cs
314 | *.odx.cs
315 | *.xsd.cs
316 |
317 | # OpenCover UI analysis results
318 | OpenCover/
319 |
320 | # Azure Stream Analytics local run output
321 | ASALocalRun/
322 |
323 | # MSBuild Binary and Structured Log
324 | *.binlog
325 |
326 | # NVidia Nsight GPU debugger configuration file
327 | *.nvuser
328 |
329 | # MFractors (Xamarin productivity tool) working folder
330 | .mfractor/
331 |
--------------------------------------------------------------------------------
/.paket/Paket.Restore.targets:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 | $(MSBuildAllProjects);$(MSBuildThisFileFullPath)
8 |
9 | true
10 | $(MSBuildThisFileDirectory)
11 | $(MSBuildThisFileDirectory)..\
12 | $(PaketRootPath)paket-files\paket.restore.cached
13 | $(PaketRootPath)paket.lock
14 | /Library/Frameworks/Mono.framework/Commands/mono
15 | mono
16 |
17 | $(PaketRootPath)paket.exe
18 | $(PaketToolsPath)paket.exe
19 | "$(PaketExePath)"
20 | $(MonoPath) --runtime=v4.0.30319 "$(PaketExePath)"
21 |
22 |
23 | <_PaketExeExtension>$([System.IO.Path]::GetExtension("$(PaketExePath)"))
24 | dotnet "$(PaketExePath)"
25 |
26 |
27 | "$(PaketExePath)"
28 |
29 | $(PaketRootPath)paket.bootstrapper.exe
30 | $(PaketToolsPath)paket.bootstrapper.exe
31 | "$(PaketBootStrapperExePath)"
32 | $(MonoPath) --runtime=v4.0.30319 "$(PaketBootStrapperExePath)"
33 |
34 |
35 |
36 |
37 | true
38 | true
39 |
40 |
41 |
42 |
43 |
44 |
45 | true
46 | $(NoWarn);NU1603;NU1604;NU1605;NU1608
47 |
48 |
49 |
50 |
51 | /usr/bin/shasum "$(PaketRestoreCacheFile)" | /usr/bin/awk '{ print $1 }'
52 | /usr/bin/shasum "$(PaketLockFilePath)" | /usr/bin/awk '{ print $1 }'
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 | $([System.IO.File]::ReadAllText('$(PaketRestoreCacheFile)'))
69 | $([System.IO.File]::ReadAllText('$(PaketLockFilePath)'))
70 | true
71 | false
72 | true
73 |
74 |
75 |
76 | true
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 | $(MSBuildProjectDirectory)\obj\$(MSBuildProjectFile).paket.references.cached
93 |
94 | $(MSBuildProjectFullPath).paket.references
95 |
96 | $(MSBuildProjectDirectory)\$(MSBuildProjectName).paket.references
97 |
98 | $(MSBuildProjectDirectory)\paket.references
99 |
100 | false
101 | true
102 | true
103 | references-file-or-cache-not-found
104 |
105 |
106 |
107 |
108 | $([System.IO.File]::ReadAllText('$(PaketReferencesCachedFilePath)'))
109 | $([System.IO.File]::ReadAllText('$(PaketOriginalReferencesFilePath)'))
110 | references-file
111 | false
112 |
113 |
114 |
115 |
116 | false
117 |
118 |
119 |
120 |
121 | true
122 | target-framework '$(TargetFramework)' or '$(TargetFrameworks)' files @(PaketResolvedFilePaths)
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 | false
133 | true
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 | $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[0])
145 | $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[1])
146 | $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[4])
147 |
148 |
149 | %(PaketReferencesFileLinesInfo.PackageVersion)
150 | All
151 | runtime
152 | true
153 |
154 |
155 |
156 |
157 | $(MSBuildProjectDirectory)/obj/$(MSBuildProjectFile).paket.clitools
158 |
159 |
160 |
161 |
162 |
163 |
164 |
165 |
166 | $([System.String]::Copy('%(PaketCliToolFileLines.Identity)').Split(',')[0])
167 | $([System.String]::Copy('%(PaketCliToolFileLines.Identity)').Split(',')[1])
168 |
169 |
170 | %(PaketCliToolFileLinesInfo.PackageVersion)
171 |
172 |
173 |
174 |
178 |
179 |
180 |
181 |
182 |
183 | false
184 |
185 |
186 |
187 |
188 |
189 | <_NuspecFilesNewLocation Include="$(BaseIntermediateOutputPath)$(Configuration)\*.nuspec"/>
190 |
191 |
192 |
193 | $(MSBuildProjectDirectory)/$(MSBuildProjectFile)
194 | true
195 | false
196 | true
197 | $(BaseIntermediateOutputPath)$(Configuration)
198 | $(BaseIntermediateOutputPath)
199 |
200 |
201 |
202 | <_NuspecFiles Include="$(AdjustedNuspecOutputPath)\*.nuspec"/>
203 |
204 |
205 |
206 |
207 |
208 |
209 |
210 |
211 |
212 |
213 |
255 |
256 |
297 |
298 |
299 |
300 |
--------------------------------------------------------------------------------
/.paket/paket.bootstrapper.exe:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rflechner/SwaggerForFsharp/4399f344da56bce1249d050f3d5fde31b86d0cb3/.paket/paket.bootstrapper.exe
--------------------------------------------------------------------------------
/.paket/paket.targets:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 | true
7 | $(MSBuildThisFileDirectory)
8 | $(MSBuildThisFileDirectory)..\
9 | $(PaketRootPath)paket.lock
10 | $(PaketRootPath)paket-files\paket.restore.cached
11 | /Library/Frameworks/Mono.framework/Commands/mono
12 | mono
13 |
14 |
15 |
16 |
17 | $(PaketRootPath)paket.exe
18 | $(PaketToolsPath)paket.exe
19 | "$(PaketExePath)"
20 | $(MonoPath) --runtime=v4.0.30319 "$(PaketExePath)"
21 |
22 |
23 |
24 |
25 |
26 | $(MSBuildProjectFullPath).paket.references
27 |
28 |
29 |
30 |
31 | $(MSBuildProjectDirectory)\$(MSBuildProjectName).paket.references
32 |
33 |
34 |
35 |
36 | $(MSBuildProjectDirectory)\paket.references
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 | $(PaketCommand) restore --references-file "$(PaketReferences)"
49 |
50 | RestorePackages; $(BuildDependsOn);
51 |
52 |
53 |
54 | true
55 |
56 |
57 |
58 | $([System.IO.File]::ReadAllText('$(PaketRestoreCacheFile)'))
59 | $([System.IO.File]::ReadAllText('$(PaketLockFilePath)'))
60 | true
61 | false
62 | true
63 |
64 |
65 |
71 |
72 |
73 |
--------------------------------------------------------------------------------
/.vscode/tasks.json:
--------------------------------------------------------------------------------
1 | {
2 | // See https://go.microsoft.com/fwlink/?LinkId=733558
3 | // for the documentation about the tasks.json format
4 | "version": "2.0.0",
5 | "tasks": [
6 | {
7 | "label": "build",
8 | "command": "dotnet",
9 | "args": [
10 | "build",
11 | "src/SwaggerForFsharp.sln"
12 | ],
13 | "type": "shell",
14 | "group": "build",
15 | "presentation": {
16 | "reveal": "silent"
17 | },
18 | "problemMatcher": "$msCompile"
19 | },
20 | {
21 | "label": "run Giraffe sample",
22 | "command": "dotnet",
23 | "args": [
24 | "run",
25 | "--project",
26 | "src/samples/SwaggerForFsharp.Giraffe.Sample/SwaggerForFsharp.Giraffe.Sample.fsproj"
27 | ],
28 | "type": "shell",
29 | "group": "build",
30 | "presentation": {
31 | "reveal": "silent"
32 | },
33 | "problemMatcher": "$msCompile"
34 | }
35 | ]
36 | }
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | This is free and unencumbered software released into the public domain.
2 |
3 | Anyone is free to copy, modify, publish, use, compile, sell, or
4 | distribute this software, either in source code form or as a compiled
5 | binary, for any purpose, commercial or non-commercial, and by any
6 | means.
7 |
8 | In jurisdictions that recognize copyright laws, the author or authors
9 | of this software dedicate any and all copyright interest in the
10 | software to the public domain. We make this dedication for the benefit
11 | of the public at large and to the detriment of our heirs and
12 | successors. We intend this dedication to be an overt act of
13 | relinquishment in perpetuity of all present and future rights to this
14 | software under copyright law.
15 |
16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
22 | OTHER DEALINGS IN THE SOFTWARE.
23 |
24 | For more information, please refer to
25 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # SwaggerForFsharp
2 |
3 | Swagger for F# project is destinated to produce libraries generating Swagger's documentation with REST frameworks like Giraffe and Suave.
4 |
5 | __This project needs feedbacks and is not really production ready.__
6 |
7 | ## Swagger for Giraffe
8 |
9 | ### NuGet
10 |
11 | Waiting maturity I only published the library on my feed MyGet.
12 |
13 | 
14 |
15 | You can use NuGet to install the library:
16 |
17 | https://www.myget.org/feed/romcyber/package/nuget/SwaggerForFsharp.Giraffe
18 |
19 | ### History
20 |
21 | In this project I propose a solution to generate a swagger for Giraffe.
22 | Issue https://github.com/giraffe-fsharp/Giraffe/issues/79 has label `help wanted` 😃 .
23 | Contributing direclty to Giraffe seems to be less reactive than creating my own project (see [PR #218](https://github.com/giraffe-fsharp/Giraffe/pull/218) )
24 |
25 | [My solution for Suave](https://rflechner.github.io/Suave.Swagger/) was effectively not really easy to use.
26 | Documentation and service implementation were too strongly coupled and the DSL was really verbose.
27 |
28 | The good news is that we still have to declare our API routes the same way as before but to enable the route analysis we have to surround the app declaration with quotation marks.
29 |
30 | With that in place we can decouple the app declaration from the analysis required to generate the swagger documentation. In other words this solution has the avantage to avoid corrupting your service implementation.
31 |
32 |
33 | ### Getting started
34 |
35 | #### Create the project
36 |
37 | You can create your project with following steps.
38 |
39 | ```shell
40 | dotnet new console --lang F#
41 | dotnet add package SwaggerForFsharp.Giraffe --version 1.0.0-CI00006 --source https://www.myget.org/F/romcyber/api/v3/index.json
42 | ```
43 |
44 | Open your `.fsproj` and edit your package references.
45 |
46 | You should have something like:
47 |
48 | ```xml
49 |
50 |
51 |
52 | Exe
53 | netcoreapp2.0
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 | ```
71 |
72 | #### Code
73 |
74 | Edit `Program.fs`
75 |
76 | ```FSharp
77 | module SwaggerGiraffeTesting.App
78 |
79 |
80 | open System
81 | open System.IO
82 | open Microsoft.AspNetCore
83 | open Microsoft.AspNetCore.Builder
84 | open Microsoft.AspNetCore.Hosting
85 | open Microsoft.AspNetCore.Http
86 | open Microsoft.AspNetCore.Authentication.Cookies
87 | open Microsoft.Extensions.Logging
88 | open Microsoft.Extensions.DependencyInjection
89 | open Giraffe
90 | open SwaggerForFsharp.Giraffe
91 | open SwaggerForFsharp.Giraffe.Common
92 | open SwaggerForFsharp.Giraffe.Generator
93 | open SwaggerForFsharp.Giraffe.Dsl
94 |
95 | let errorHandler (ex : Exception) (logger : ILogger) =
96 | logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.")
97 | clearResponse >=> setStatusCode 500 >=> text ex.Message
98 | let authScheme = CookieAuthenticationDefaults.AuthenticationScheme
99 | let time() = System.DateTime.Now.ToString()
100 | let bonjour (firstName, lastName) =
101 | let message = sprintf "%s %s, vous avez le bonjour de Giraffe !" lastName firstName
102 | text message
103 |
104 | let httpFailWith message =
105 | setStatusCode 500 >=> text message
106 |
107 | let docAddendums =
108 | fun (route:Analyzer.RouteInfos) (path:string,verb:HttpVerb,pathDef:PathDefinition) ->
109 |
110 | // routef params are automatically added to swagger, but you can customize their names like this
111 | let changeParamName oldName newName (parameters:ParamDefinition list) =
112 | parameters |> Seq.find (fun p -> p.Name = oldName) |> fun p -> { p with Name = newName }
113 |
114 | match path,verb,pathDef with
115 | | _,_, def when def.OperationId = "say_hello_in_french" ->
116 | let firstname = def.Parameters |> changeParamName "arg0" "Firstname"
117 | let lastname = def.Parameters |> changeParamName "arg1" "Lastname"
118 | "/hello/{Firstname}/{Lastname}", verb, { def with Parameters = [firstname; lastname] }
119 | | _ -> path,verb,pathDef
120 | let port = 5000
121 |
122 | let docsConfig c =
123 | let describeWith desc =
124 | { desc
125 | with
126 | Title="Sample 1"
127 | Description="Create a swagger with Giraffe"
128 | TermsOfService="Coucou"
129 | }
130 |
131 | { c with
132 | Description = describeWith
133 | Host = sprintf "localhost:%d" port
134 | DocumentationAddendums = docAddendums
135 | }
136 |
137 | let webApp =
138 | swaggerOf
139 | ( choose [
140 | GET >=>
141 | choose [
142 | route "/" >=> text "index"
143 | route "/ping" >=> text "pong"
144 | // Swagger operation id can be defined like this or with DocumentationAddendums
145 | operationId "say_hello_in_french" ==>
146 | routef "/hello/%s/%s" bonjour
147 | ]
148 | RequestErrors.notFound (text "Not Found") ]
149 | ) |> withConfig docsConfig
150 |
151 | // ---------------------------------
152 | // Main
153 | // ---------------------------------
154 |
155 | let cookieAuth (o : CookieAuthenticationOptions) =
156 | do
157 | o.Cookie.HttpOnly <- true
158 | o.Cookie.SecurePolicy <- CookieSecurePolicy.SameAsRequest
159 | o.SlidingExpiration <- true
160 | o.ExpireTimeSpan <- TimeSpan.FromDays 7.0
161 |
162 | let configureApp (app : IApplicationBuilder) =
163 |
164 | app.UseGiraffeErrorHandler(errorHandler)
165 | .UseStaticFiles()
166 | .UseAuthentication()
167 | .UseGiraffe webApp
168 |
169 | let configureServices (services : IServiceCollection) =
170 | services
171 | .AddGiraffe()
172 | .AddAuthentication(authScheme)
173 | .AddCookie(cookieAuth) |> ignore
174 | services.AddDataProtection() |> ignore
175 |
176 | let configureLogging (loggerBuilder : ILoggingBuilder) =
177 | loggerBuilder.AddFilter(fun lvl -> lvl.Equals LogLevel.Error)
178 | .AddConsole()
179 | .AddDebug() |> ignore
180 |
181 | []
182 | let main _ =
183 | let contentRoot = Directory.GetCurrentDirectory()
184 | let webRoot = Path.Combine(contentRoot, "WebRoot")
185 | let url = sprintf "http://+:%d" port
186 |
187 | WebHost.CreateDefaultBuilder()
188 | .UseUrls(url)
189 | .UseWebRoot(webRoot)
190 | .Configure(Action configureApp)
191 | .ConfigureServices(configureServices)
192 | .ConfigureLogging(configureLogging)
193 | .Build()
194 | .Run()
195 | 0
196 | ```
197 |
198 | #### Build and run
199 |
200 | Run with
201 |
202 | ```shell
203 | dotnet build
204 | dotnet run
205 | ```
206 |
207 | Go to url http://localhost:5000/swaggerui/index.html
208 |
209 | ### How does it work ?
210 |
211 | I introduced the `documents` function that takes two arguments:
212 | 1. the quotation expression containing webservice implementation.
213 | 2. a `DocumentationConfig` argument.
214 |
215 | This function does the analysis of your quotation to generate Swagger documentation.
216 |
217 | `DocumentationConfig` contains the following properties:
218 |
219 | - `MethodCallRules`: allow you to provide custom functions to enrich DSL and / or quotation analysis.
220 | - `DocumentationAddendums`: allow you to add more informations to the documentation without introducing service implementation modification.
221 |
222 | I introduced `==>` operator that gives the possibility to add `decorations` in routes implementations.
223 |
224 | ### Examples
225 |
226 | There are 2 solutions to add documentation for a route.
227 |
228 | [See example](./src/samples/SwaggerForFsharp.Giraffe.Sample/Program.fs)
229 |
230 | - [First one](./src/samples/SwaggerForFsharp.Giraffe.Sample/Program.fs#L183)
231 |
232 | ```fsharp
233 | ...
234 | operationId "send_a_car" ==>
235 | consumes tcar ==>
236 | produces typeof ==>
237 | route "/car2" >=> submitCar
238 | ...
239 | ```
240 |
241 | - [Second one](./src/samples/SwaggerForFsharp.Giraffe.Sample/Program.fs#L181)
242 |
243 | using `DocumentationAddendums`
244 |
245 | ```fsharp
246 | ...
247 | route "/car" >=> submitCar
248 | ...
249 |
250 | let docAddendums =
251 | fun (route:Analyzer.RouteInfos) (path:string,verb:HttpVerb,pathDef:PathDefinition) ->
252 | match path,verb,pathDef with
253 | | "/car", HttpVerb.Post,def ->
254 | let ndef =
255 | (def.AddConsume "model" "application/json" Body typeof)
256 | .AddResponse 200 "application/json" "A car" typeof
257 | path, verb, ndef
258 | ...
259 | ```
260 |
261 | ### Next steps
262 |
263 | #### SwaggerUi
264 |
265 | In futur, SwaggerUi could be a submodule of the repository (if you like and accept this PR 😄 ).
266 |
267 | #### Quotations and Giraffe
268 |
269 | Some features could be missing and some quotations could be difficult to parse.
270 | For the moment, analyzer works with most basics [default httphandlers](https://github.com/giraffe-fsharp/Giraffe#default-httphandlers).
271 |
272 | I only implemented:
273 |
274 | - GET
275 | - POST
276 | - PUT
277 | - PATCH
278 | - DELETE
279 | - route
280 | - routeCi
281 | - routef
282 | - setStatusCode
283 | - text
284 | - json
285 | - choose
286 | - subRouteCi
287 | - subRoute
288 |
289 | You can build and run [SwaggerSample/Program.fs](./src/samples/SwaggerForFsharp.Giraffe.Sample/Program.fs) and
290 | go to http://localhost:5000/swaggerui/
291 |
292 | 
293 |
294 | #### Suave
295 |
296 | Next step will consist to add genericity and implement a version for Suave.io
297 |
298 |
--------------------------------------------------------------------------------
/build.cmd:
--------------------------------------------------------------------------------
1 | fake.cmd build
2 |
--------------------------------------------------------------------------------
/build.fsx:
--------------------------------------------------------------------------------
1 | #load ".fake/build.fsx/intellisense.fsx"
2 |
3 | #if !FAKE
4 | #r "netstandard"
5 | let execContext = Fake.Core.Context.FakeExecutionContext.Create false "build.fsx" []
6 | Fake.Core.Context.setExecutionContext (Fake.Core.Context.RuntimeContext.Fake execContext)
7 | #endif
8 |
9 | open Fake.Core
10 | open Fake.DotNet
11 | open Fake.IO
12 | open Fake.IO.FileSystemOperators
13 | open Fake.IO.Globbing.Operators
14 | open Fake.Core.TargetOperators
15 |
16 | Target.create "Clean" (fun _ ->
17 | !! "src/**/bin"
18 | ++ "src/**/obj"
19 | |> Shell.cleanDirs
20 | )
21 |
22 | Target.create "Restore" (fun _ ->
23 | !! "src/**/*.*proj"
24 | |> Seq.iter (DotNet.restore id)
25 | )
26 |
27 | Target.create "Build" (fun _ ->
28 | !! "src/**/*.*proj"
29 | |> Seq.iter (DotNet.build id)
30 | )
31 |
32 | Target.create "Pack" (fun _ ->
33 | let nugetsDir = __SOURCE_DIRECTORY__ > "releases"
34 | !! "src/SwaggerForFsharp.Giraffe/*.fsproj"
35 | |> Seq.iter (
36 | DotNet.pack
37 | <| fun settings ->
38 | { settings
39 | with OutputPath=Some nugetsDir
40 | }
41 | )
42 | )
43 |
44 | Target.create "All" ignore
45 |
46 | "Clean"
47 | ==> "Restore"
48 | ==> "Build"
49 | ==> "Pack"
50 | ==> "All"
51 |
52 | Target.runOrDefault "All"
53 |
--------------------------------------------------------------------------------
/fake.cmd:
--------------------------------------------------------------------------------
1 | SET TOOL_PATH=.fake
2 |
3 | IF NOT EXIST "%TOOL_PATH%\fake.exe" (
4 | dotnet tool install fake-cli --tool-path ./%TOOL_PATH% --version 5.*
5 | )
6 |
7 | "%TOOL_PATH%/fake.exe" %*
--------------------------------------------------------------------------------
/fake.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 |
3 | set -eu
4 | set -o pipefail
5 |
6 | # liberated from https://stackoverflow.com/a/18443300/433393
7 | realpath() {
8 | OURPWD=$PWD
9 | cd "$(dirname "$1")"
10 | LINK=$(readlink "$(basename "$1")")
11 | while [ "$LINK" ]; do
12 | cd "$(dirname "$LINK")"
13 | LINK=$(readlink "$(basename "$1")")
14 | done
15 | REALPATH="$PWD/$(basename "$1")"
16 | cd "$OURPWD"
17 | echo "$REALPATH"
18 | }
19 |
20 | TOOL_PATH=$(realpath .fake)
21 | FAKE="$TOOL_PATH"/fake
22 |
23 | if ! [ -e "$FAKE" ]
24 | then
25 | dotnet tool install fake-cli --tool-path $TOOL_PATH --version 5.*
26 | fi
27 | "$FAKE" "$@"
28 |
--------------------------------------------------------------------------------
/images/screen1.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rflechner/SwaggerForFsharp/4399f344da56bce1249d050f3d5fde31b86d0cb3/images/screen1.gif
--------------------------------------------------------------------------------
/paket.dependencies:
--------------------------------------------------------------------------------
1 | source https://api.nuget.org/v3/index.json
2 |
3 | nuget FsCheck.Xunit
4 | nuget FSharp.Quotations.Evaluator 1.1.2
5 | nuget Giraffe 1.1.0
6 | nuget Newtonsoft.Json 11.0.2
7 | nuget NSubstitute
8 | nuget xunit
9 | nuget xunit.runner.visualstudio
10 |
11 | // [ FAKE GROUP ]
12 | group Build
13 | source https://api.nuget.org/v3/index.json
14 | nuget Fake.DotNet.Cli
15 | nuget Fake.IO.FileSystem
16 | nuget Fake.Core.Target
--------------------------------------------------------------------------------
/src/SwaggerForFsharp.Giraffe/Analyzer.fs:
--------------------------------------------------------------------------------
1 | namespace SwaggerForFsharp.Giraffe
2 |
3 | open Giraffe
4 | open System
5 | open System.Linq.Expressions
6 | open System.Reflection
7 | open Microsoft.FSharp.Quotations
8 | open Quotations.DerivedPatterns
9 | open Quotations.ExprShape
10 | open Quotations.Patterns
11 | open Microsoft.FSharp.Reflection
12 | open FSharp.Quotations.Evaluator
13 | open Microsoft.AspNetCore.Http
14 | open System.Collections.Generic
15 | open Newtonsoft
16 | open Newtonsoft.Json
17 | open Newtonsoft.Json.Serialization
18 | open Newtonsoft.Json.Linq
19 | open Common
20 |
21 | module Analyzer =
22 |
23 | type FormatParsed =
24 | | StringPart | CharPart | BoolPart | IntPart
25 | | DecimalPart | HexaPart
26 | type FormatPart =
27 | | Constant of string
28 | | Parsed of FormatParsed
29 | type FormatParser =
30 | { Parts:FormatPart list ref
31 | Buffer:char list ref
32 | Format:string
33 | Position:int ref }
34 | static member Parse f =
35 | { Parts = ref List.empty
36 | Buffer = ref List.empty
37 | Format = f
38 | Position = ref 0 }.Parse()
39 | member x.Acc (s:string) =
40 | x.Buffer := !x.Buffer @ (s.ToCharArray() |> Seq.toList)
41 | member x.Acc (c:char) =
42 | x.Buffer := !x.Buffer @ [c]
43 | member private x.Finished () =
44 | !x.Position >= x.Format.Length
45 | member x.Next() =
46 | if x.Finished() |> not then
47 | x.Format.Chars !x.Position |> x.Acc
48 | x.Position := !x.Position + 1
49 | member x.PreviewNext() =
50 | if !x.Position >= x.Format.Length - 1
51 | then None
52 | else Some (x.Format.Chars (!x.Position))
53 | member x.Push t =
54 | x.Parts := !x.Parts @ t
55 | x.Buffer := List.empty
56 | member x.StringBuffer skip =
57 | let c = !x.Buffer |> Seq.skip skip |> Seq.toArray
58 | new String(c)
59 | member x.Parse () =
60 | while x.Finished() |> not do
61 | x.Next()
62 | match !x.Buffer with
63 | | '%' :: '%' :: _ -> x.Push [Constant (x.StringBuffer 1)]
64 | | '%' :: 'b' :: _ -> x.Push [Parsed BoolPart]
65 | | '%' :: 'i' :: _
66 | | '%' :: 'u' :: _
67 | | '%' :: 'd' :: _ -> x.Push [Parsed IntPart]
68 | | '%' :: 'c' :: _ -> x.Push [Parsed StringPart]
69 | | '%' :: 's' :: _ -> x.Push [Parsed StringPart]
70 | | '%' :: 'e' :: _
71 | | '%' :: 'E' :: _
72 | | '%' :: 'f' :: _
73 | | '%' :: 'F' :: _
74 | | '%' :: 'g' :: _
75 | | '%' :: 'G' :: _ -> x.Push [Parsed DecimalPart]
76 | | '%' :: 'x' :: _
77 | | '%' :: 'X' :: _ -> x.Push [Parsed HexaPart]
78 | | _ :: _ ->
79 | let n = x.PreviewNext()
80 | match n with
81 | | Some '%' -> x.Push [Constant (x.StringBuffer 0)]
82 | | _ -> ()
83 | | _ -> ()
84 | if !x.Buffer |> Seq.isEmpty |> not then x.Push [Constant (x.StringBuffer 0)]
85 | !x.Parts
86 |
87 | type RouteInfos =
88 | { Verb:string
89 | Path:string
90 | MetaData:Map
91 | Parameters:ParamDescriptor list
92 | Responses:ResponseInfos list }
93 | and ResponseInfos =
94 | { StatusCode:int
95 | ContentType:string
96 | ModelType:Type }
97 | type PathFormat =
98 | { Template:string
99 | ArgTypes:Type list }
100 |
101 | type AnalyzeContext =
102 | {
103 | ArgTypes : Type list
104 | Variables : Map
105 | Routes : RouteInfos list
106 | Responses : ResponseInfos list
107 | Verb : string option
108 | CurrentRoute : RouteInfos option ref
109 | Parameters : ParamDescriptor list
110 | MetaData:Map
111 | }
112 | static member Empty
113 | with get () =
114 | {
115 | ArgTypes = List.empty
116 | Variables = Map.empty
117 | Routes = List.empty
118 | Verb = None
119 | Responses = List.empty
120 | CurrentRoute = ref None
121 | Parameters = List.empty
122 | MetaData = Map.empty
123 | }
124 | member __.PushRoute () =
125 | match !__.CurrentRoute with
126 | | Some route ->
127 | let meta = mergeMaps __.MetaData route.MetaData
128 | let r =
129 | { route
130 | with
131 | Responses=(__.Responses @ route.Responses |> List.distinct)
132 | Parameters=(__.Parameters @ route.Parameters)
133 | MetaData=meta
134 | }
135 | __.CurrentRoute := None
136 | { __ with Parameters=List.Empty; Responses=[]; ArgTypes=[]; Routes = r :: __.Routes; MetaData=Map.empty }
137 | | None ->
138 | let routes =
139 | match __.Routes with
140 | | route :: s ->
141 | let meta = mergeMaps __.MetaData route.MetaData
142 | { route
143 | with
144 | Responses=(__.Responses @ route.Responses |> List.distinct)
145 | Parameters=(__.Parameters @ route.Parameters |> List.distinct)
146 | MetaData=meta
147 | } :: s
148 | | v -> v
149 | { __ with ArgTypes=[]; Routes = (List.distinct routes); }
150 | member __.AddResponse code contentType (modelType:Type) =
151 | let rs = { StatusCode=code; ContentType=contentType; ModelType=modelType }
152 | { __ with Responses = rs :: __.Responses }
153 | member __.AddRoute verb parameters path =
154 | let ctx = __.PushRoute ()
155 | ctx.CurrentRoute := Some { Verb=verb; Path=path; Responses=[]; Parameters=( __.Parameters @ parameters); MetaData=Map.empty }
156 | ctx
157 | member __.AddParameter parameter =
158 | { __ with Parameters=(parameter :: __.Parameters) }
159 | member __.ClearVariables () =
160 | { __ with Variables = Map.empty }
161 | member __.SetVariable name value =
162 | let vars = __.Variables
163 | let nvars =
164 | if vars.ContainsKey name
165 | then vars.Remove(name).Add(name, value)
166 | else vars.Add(name, value)
167 | { __ with Variables = nvars }
168 | member __.AddArgType ``type`` =
169 | { __ with ArgTypes = (``type`` :: __.ArgTypes) }
170 | member __.GetVerb() =
171 | __.Verb |> getVerb
172 | member __.MergeWith (other:AnalyzeContext) =
173 | let variables = joinMaps __.Variables other.Variables
174 | let verb =
175 | match __.Verb, other.Verb with
176 | | Some v, None -> Some v
177 | | None, Some v -> Some v
178 | | None, None -> None
179 | | Some v1, Some v2 -> Some v2
180 |
181 | let currentRoute =
182 | match !__.CurrentRoute, !other.CurrentRoute with
183 | | Some v, None -> Some v
184 | | None, Some v -> Some v
185 | | Some route1, Some route2 ->
186 | Some {
187 | route1
188 | with
189 | Parameters = (route1.Parameters @ route2.Parameters) |> List.distinct
190 | Responses = (route1.Responses @ route2.Responses) |> List.distinct
191 | }
192 | | None, None -> None
193 | let meta = mergeMaps __.MetaData other.MetaData
194 | {
195 | ArgTypes = __.ArgTypes @ other.ArgTypes
196 | Variables = variables
197 | Routes = __.Routes @ other.Routes
198 | Verb = verb
199 | Responses = __.Responses @ other.Responses
200 | CurrentRoute = ref currentRoute
201 | Parameters = (__.Parameters @ other.Parameters) |> List.distinct
202 | MetaData = meta
203 | }
204 |
205 | let mergeWith (a:AnalyzeContext) =
206 | a.MergeWith
207 |
208 | let pushRoute (a:AnalyzeContext) =
209 | a.PushRoute()
210 |
211 | let handleSingleArgRule argName funcName ctx =
212 | let arg =
213 | match ctx.Variables.Item argName with
214 | | :? Type as typ -> typ.AssemblyQualifiedName
215 | | v -> toString v
216 | let m = ctx.MetaData.Add(funcName, arg)
217 | { ctx with MetaData=m }
218 |
219 | type MethodCallId =
220 | { ModuleName:string
221 | FunctionName:string }
222 | type AnalyzeRuleBody = AnalyzeContext -> AnalyzeContext
223 | type AppAnalyzeRules =
224 | { MethodCalls:Map }
225 | member __.ApplyMethodCall moduleName functionName ctx =
226 | let key = { ModuleName=moduleName; FunctionName=functionName }
227 | if __.MethodCalls.ContainsKey key
228 | then ctx |> __.MethodCalls.Item key
229 | else ctx
230 |
231 | static member Default =
232 | let methodCalls =
233 | [
234 | // simple route
235 | { ModuleName="Routing"; FunctionName="route" },
236 | (fun ctx -> ctx.Variables.Item "path" |> toString |> ctx.AddRoute (ctx.GetVerb()) List.empty)
237 | { ModuleName="Routing"; FunctionName="routeCi" },
238 | (fun ctx -> ctx.Variables.Item "path" |> toString |> ctx.AddRoute (ctx.GetVerb()) List.empty)
239 |
240 | // route format
241 | { ModuleName="Routing"; FunctionName="routef" },
242 | (fun ctx ->
243 | let path = ctx.Variables.Item "pathFormat" :?> PathFormat
244 | let parameters =
245 | path.ArgTypes
246 | |> List.mapi(
247 | fun i typ ->
248 | let name = (sprintf "arg%d" i)
249 | ParamDescriptor.InPath name typ)
250 | ctx.AddRoute (ctx.GetVerb()) parameters path.Template
251 | )
252 |
253 | // used to return raw text content
254 | { ModuleName="Core"; FunctionName="setStatusCode" },
255 | (fun ctx ->
256 | let code = ctx.Variables.Item "statusCode" |> toString |> Int32.Parse
257 | ctx.AddResponse code "text/plain" (typeof)
258 | )
259 |
260 | // used to return raw text content
261 | { ModuleName="ResponseWriters"; FunctionName="text" },
262 | (fun ctx -> ctx.AddResponse 200 "text/plain" (typeof))
263 |
264 | // used to return json content
265 | { ModuleName="ResponseWriters"; FunctionName="json" },
266 | (fun ctx ->
267 | let modelType =
268 | match ctx.ArgTypes |> List.tryHead with
269 | | Some t -> t
270 | | None -> typeof
271 | ctx.AddResponse 200 "application/json" modelType
272 | )
273 |
274 | // HTTP GET method
275 | { ModuleName="Core"; FunctionName="GET" }, (fun ctx -> { ctx with Verb = (Some "GET") })
276 | // HTTP POST method
277 | { ModuleName="Core"; FunctionName="POST" }, (fun ctx -> { ctx with Verb = (Some "POST") })
278 | // HTTP PUT method
279 | { ModuleName="Core"; FunctionName="PUT" }, (fun ctx -> { ctx with Verb = (Some "PUT") })
280 | // HTTP DELETE method
281 | { ModuleName="Core"; FunctionName="DELETE" }, (fun ctx -> { ctx with Verb = (Some "DELETE") })
282 | // HTTP PATCH method
283 | { ModuleName="Core"; FunctionName="PATCH" }, (fun ctx -> { ctx with Verb = (Some "PATCH") })
284 |
285 | { ModuleName="Dsl"; FunctionName="operationId" }, (handleSingleArgRule "opId" "operationId")
286 | { ModuleName="Dsl"; FunctionName="consumes" }, (handleSingleArgRule "modelType" "consumes")
287 | { ModuleName="Dsl"; FunctionName="produces" }, (handleSingleArgRule "modelType" "produces")
288 |
289 | ] |> Map
290 | { MethodCalls=methodCalls }
291 |
292 | let analyze webapp (rules:AppAnalyzeRules) : AnalyzeContext =
293 |
294 | let (|IsSubRoute|_|) (m:MethodInfo) =
295 | if (m.Name = "subRouteCi" || m.Name = "subRoute") && m.DeclaringType.Name = "Routing"
296 | then Some ()
297 | else None
298 |
299 | let rec loop exp (ctx:AnalyzeContext) : AnalyzeContext =
300 |
301 | let newContext() =
302 | { AnalyzeContext.Empty with
303 | Responses = ctx.Responses
304 | Verb = ctx.Verb
305 | ArgTypes = ctx.ArgTypes
306 | Parameters = ctx.Parameters
307 | MetaData = ctx.MetaData
308 | Variables = ctx.Variables
309 | Routes = ctx.Routes }
310 |
311 | let analyzeAll exps c =
312 | exps |> Seq.fold (fun state e -> loop e state) c
313 |
314 | match exp with
315 | | Value (o,_) ->
316 | ctx.AddArgType (o.GetType())
317 |
318 | | Let (v, NewUnionCase (_,handlers), Lambda (next, Call (None, m, _))) when v.Name = "handlers" && m.Name = "choose" && m.DeclaringType.Name = "Core" ->
319 | let ctxs = handlers |> List.map(fun e -> loop e ctx)
320 | { ctx
321 | with
322 | Routes = (ctxs |> List.collect (fun c -> c.Routes) |> List.append ctx.Routes |> List.distinct)
323 | Responses = (ctxs |> List.collect (fun c -> c.Responses) |> List.append ctx.Responses |> List.distinct)
324 | CurrentRoute = ctx.CurrentRoute
325 | }
326 |
327 | | Let (id,op,t) ->
328 | match op with
329 | | Value (o,typ) when typ = typeof ->
330 | let v = unbox o
331 | ctx.SetVariable id.Name v.AssemblyQualifiedName |> loop t
332 | | Value (o,_) ->
333 | ctx.SetVariable id.Name (o.ToString()) |> loop t
334 | | Call (None, method, args) when method.Name = "TypeOf" ->
335 | let ty = method.GetGenericArguments() |> Seq.head
336 | ctx.SetVariable id.Name (ty.AssemblyQualifiedName) |> loop t
337 | | o ->
338 | analyzeAll [o;t] ctx
339 |
340 | | NewUnionCase (_,exprs) ->
341 | let mustPush =
342 | match exprs with
343 | | Let _ :: _ -> true
344 | | NewUnionCase _ :: _ -> true
345 | | _ ->
346 | match exprs |> List.tryLast with
347 | | None -> false
348 | | Some l ->
349 | match l with
350 | | NewUnionCase _ -> true
351 | | _ -> false
352 | let r = analyzeAll exprs ctx
353 | if mustPush
354 | then pushRoute r
355 | else r
356 |
357 | | Application (Application (PropertyGet (None, op, _), PropertyGet (None, (IsHttpVerb verb), _)), exp) when op.Name = "op_GreaterEqualsGreater" ->
358 | let v = Some(verb.ToString())
359 | let ctx = { ctx with Verb=v }
360 | loop exp ctx
361 |
362 | | Application (Application (PropertyGet (None, op, []), Let (varname, Value (name,_), Lambda (_, Call (None, method, _))) ), exp2) when op.Name = "op_EqualsEqualsGreater" ->
363 | let c2 = loop exp2 AnalyzeContext.Empty
364 | let vars = c2.Variables.Add (varname.Name, name)
365 | let c3 = { c2 with Variables=vars }
366 | let c4 = rules.ApplyMethodCall method.DeclaringType.Name method.Name c3
367 | c4 |> pushRoute |> mergeWith ctx |> pushRoute
368 |
369 | | Application (Application (PropertyGet (None, op, []), exp1 ), ValueWithName _) when op.Name = "op_GreaterEqualsGreater" ->
370 | let c1 = loop exp1 (newContext())
371 | let c = ctx |> pushRoute |> mergeWith c1 |> pushRoute
372 | c
373 |
374 | | Application (PropertyGet (instance, propertyInfo, pargs), Coerce (Var arg, o)) ->
375 | ctx.AddArgType arg.Type |> rules.ApplyMethodCall propertyInfo.DeclaringType.Name propertyInfo.Name
376 |
377 | | Application (left, right) ->
378 | let c1 = loop right (newContext())
379 | let c2 = loop left (newContext())
380 | c1 |> mergeWith c2 |> pushRoute
381 |
382 | | Call(instance, IsSubRoute, args) ->
383 | match args with
384 | | Value (v, t) :: args when t = typeof ->
385 | let path = unbox v
386 | let ctx2 = analyzeAll args AnalyzeContext.Empty
387 | let routes =
388 | ctx2.Routes
389 | |> List.map (
390 | fun route -> { route with Path = (path + route.Path) })
391 | { ctx with Routes = (ctx.Routes @ routes) }
392 | | _ -> ctx
393 |
394 | | Call(instance, method, args) when method.Name = "choose" && method.DeclaringType.Name = "Core" ->
395 | let ctxs = args |> List.map(fun e -> loop e (newContext()))
396 | { ctx
397 | with
398 | Routes = (ctxs |> List.collect (fun c -> c.Routes) |> List.append ctx.Routes |> List.distinct)
399 | Responses = (ctxs |> List.collect (fun c -> c.Responses) |> List.append ctx.Responses |> List.distinct)
400 | CurrentRoute = ctx.CurrentRoute
401 | }
402 |
403 | | Call (None, method, args) ->
404 | let parameters = method.GetParameters()
405 | let variables =
406 | parameters
407 | |> Array.mapi (fun i p -> i,p)
408 | |> Array.choose (
409 | fun (i,p) ->
410 | let arg = args.Item i
411 | match arg with
412 | | Call (None, m, []) ->
413 | None
414 | | PropertyGet (None, prop, []) ->
415 | let value = prop.GetValue(null)
416 | Some (p.Name, p.ParameterType, value)
417 | | _ -> None
418 | )
419 | if Array.isEmpty variables
420 | then
421 | let c1 = analyzeAll args ctx
422 | rules.ApplyMethodCall method.DeclaringType.Name method.Name c1
423 | else
424 | let vars =
425 | variables
426 | |> Array.fold (
427 | fun (state:Map) (name,_, value) ->
428 | state.Add(name, value))
429 | ctx.Variables
430 | let c3 = { ctx with Variables=vars }
431 | let c4 = rules.ApplyMethodCall method.DeclaringType.Name method.Name c3
432 | c4 |> pushRoute |> mergeWith ctx |> pushRoute
433 | | Call(instance, method, args) ->
434 | let c1 = analyzeAll args ctx
435 | rules.ApplyMethodCall method.DeclaringType.Name method.Name c1
436 |
437 | | PropertyGet (Some (PropertyGet (Some (PropertyGet (Some _, request, [])), form, [])), item, [Value (varname,_)]) ->
438 | let c =
439 | match form.PropertyType.Name with
440 | | "IFormCollection" -> FormData
441 | | _ -> Query
442 | ctx.AddParameter {Name=(varname.ToString()); Type=None; In=c; Required=true}
443 |
444 | | PropertyGet (instance, propertyInfo, pargs) ->
445 | rules.ApplyMethodCall propertyInfo.DeclaringType.Name propertyInfo.Name ctx
446 |
447 | | Lambda(_, e2) ->
448 | loop e2 ctx
449 | | IfThenElse(ifExp, thenExp, elseExp) ->
450 | analyzeAll [ifExp; thenExp; elseExp] ctx
451 | | Coerce (_,_) -> ctx
452 | | NewRecord (``type``,_) ->
453 | ctx.AddArgType ``type``
454 | | Var _ -> ctx
455 | | NewObject(``constructor``, arguments) ->
456 | let t = ``constructor``.DeclaringType
457 | if t.IsGenericType
458 | then
459 | let gt = t.GetGenericTypeDefinition()
460 | let td = typedefof>
461 | if gt = td
462 | then
463 | match arguments with
464 | | [Value (o,ty)] when ty = typeof ->
465 | let argType = t.GetGenericArguments() |> Seq.last
466 | let types =
467 | if argType.IsGenericType
468 | then argType.GetGenericArguments() |> Seq.toList
469 | else [argType]
470 |
471 | let format:PathFormat = { Template=(o.ToString()); ArgTypes=types }
472 | ctx.SetVariable "pathFormat" format
473 | | _ -> ctx
474 | else ctx
475 | else ctx
476 | | TupleGet (tupledArg, i) ->
477 | ctx
478 | | e ->
479 | //failwithf "not implemented %A" e
480 | printfn "not implemented %A" e
481 | ctx
482 |
483 | let ctx = AnalyzeContext.Empty
484 | let r = loop webapp ctx
485 | r.PushRoute()
486 |
487 |
--------------------------------------------------------------------------------
/src/SwaggerForFsharp.Giraffe/Common.fs:
--------------------------------------------------------------------------------
1 | namespace SwaggerForFsharp.Giraffe
2 |
3 | open System
4 | open System.Linq.Expressions
5 | open System.Reflection
6 | open Microsoft.FSharp.Quotations
7 | open Quotations.DerivedPatterns
8 | open Quotations.ExprShape
9 | open Quotations.Patterns
10 | open Microsoft.FSharp.Reflection
11 | open FSharp.Quotations.Evaluator
12 | open Microsoft.AspNetCore.Http
13 |
14 | module Common =
15 |
16 | let joinMaps (p:Map<'a,'b>) (q:Map<'a,'b>) =
17 | Map(Seq.concat [ (Map.toSeq p) ; (Map.toSeq q) ])
18 |
19 | let getVerb = Option.defaultWith (fun _ -> "get")
20 |
21 | let toString (o:obj) = o.ToString()
22 |
23 | type HttpVerb =
24 | | Get | Put | Post | Delete | Options | Head | Patch
25 | override __.ToString() =
26 | match __ with
27 | | Get -> "get" | Put -> "put"
28 | | Post -> "post" | Delete -> "delete"
29 | | Options -> "options" | Head -> "head"
30 | | Patch -> "patch"
31 | static member TryParse (text:string) =
32 | match text.ToLowerInvariant() with
33 | | "put" -> Some Put
34 | | "post" -> Some Post
35 | | "delete" -> Some Delete
36 | | "head" -> Some Head
37 | | "patch" -> Some Patch
38 | | "options" -> Some Options
39 | | _ -> None
40 | static member Parse (text:string) =
41 | text |> HttpVerb.TryParse |> Option.defaultWith (fun _ -> Get)
42 |
43 | let (|IsHttpVerb|_|) (prop:PropertyInfo) =
44 | HttpVerb.TryParse prop.Name
45 |
46 | let mergeMaps (m1:Map<'k,'v>) (m2:Map<'k,'v>) =
47 | m1
48 | |> Map.fold (
49 | fun state k v ->
50 | if state |> Map.containsKey k
51 | then state
52 | else state.Add(k,v)
53 | ) m2
54 |
55 | type ParamDescriptor =
56 | { Name:string
57 | Type:Type option
58 | In:ParamContainer
59 | Required:bool }
60 | static member InQuery n t =
61 | {Name=n; Type=(Some t); In=Query; Required=true}
62 | static member InPath n t =
63 | {Name=n; Type=(Some t); In=Path; Required=true}
64 | static member InForm n t =
65 | {Name=n; Type=(Some t); In=FormData; Required=true}
66 | static member Named n =
67 | {Name=n; Type=None; In=Query; Required=true}
68 | and ParamContainer =
69 | | Query | Header | Path | FormData | Body
70 | override __.ToString() =
71 | match __ with
72 | | Query -> "query" | Header -> "header"
73 | | Path -> "path" | FormData -> "formData"
74 | | Body -> "body"
75 |
--------------------------------------------------------------------------------
/src/SwaggerForFsharp.Giraffe/Generator.fs:
--------------------------------------------------------------------------------
1 | namespace SwaggerForFsharp.Giraffe
2 |
3 | open Giraffe
4 | open System
5 | open System.Linq.Expressions
6 | open System.Reflection
7 | open Microsoft.FSharp.Quotations
8 | open Quotations.DerivedPatterns
9 | open Quotations.ExprShape
10 | open Quotations.Patterns
11 | open Microsoft.FSharp.Reflection
12 | open FSharp.Quotations.Evaluator
13 | open Microsoft.AspNetCore.Http
14 | open System.Collections.Generic
15 | open Newtonsoft
16 | open Newtonsoft.Json
17 | open Newtonsoft.Json.Serialization
18 | open Newtonsoft.Json.Linq
19 | open Common
20 |
21 | module Generator =
22 |
23 | open System.Collections.Generic
24 | open Newtonsoft
25 | open Newtonsoft.Json
26 | open Newtonsoft.Json.Serialization
27 | open Newtonsoft.Json.Linq
28 |
29 | type JsonWriter with
30 | member __.WriteProperty name (value:obj) =
31 | __.WritePropertyName name
32 | __.WriteValue value
33 |
34 | type RouteDescriptor =
35 | { Template: string
36 | Description: string
37 | Summary: string
38 | OperationId: string
39 | Produces: string list
40 | Consumes: string list
41 | Tags : string list
42 | Params: ParamDescriptor list
43 | Verb:HttpVerb
44 | Responses:IDictionary }
45 | static member Empty =
46 | { Template=""; Description=""; Params=[]; Verb=Get; Summary=""
47 | OperationId=""; Produces=[]; Responses=dict[]; Consumes=[]; Tags = [] }
48 | and ResponseDoc =
49 | { Description:string
50 | Schema:ObjectDefinition option }
51 | static member Default = {Description="Not documented"; Schema=None}
52 | member __.IsDefault() = __ = ResponseDoc.Default
53 | and ApiDescription =
54 | { Title:string
55 | Description:string
56 | TermsOfService:string
57 | Version:string
58 | Contact:Contact
59 | License:LicenseInfos }
60 | static member Empty =
61 | { Title=""; Description=""; TermsOfService=""; Version="";
62 | Contact=Contact.Empty; License=LicenseInfos.Empty }
63 | and Contact =
64 | { Name:string; Url:string; Email:string }
65 | static member Empty =
66 | { Name=""; Url=""; Email=null }
67 | and LicenseInfos =
68 | { Name:string; Url:string }
69 | static member Empty =
70 | { Name=""; Url="" }
71 | and ObjectDefinition =
72 | { Id:string
73 | Properties:IDictionary }
74 | member __.FlattenComplexDefinitions () =
75 | let flatten defs =
76 | let rec loop acc (currents:PropertyDefinition seq) =
77 | seq {
78 | for d in currents do
79 | match d with
80 | | Ref r -> yield! r.Properties.Values |> loop (r :: acc)
81 | | Collection d -> yield! [d] |> loop acc
82 | | _ -> yield! acc
83 | } |> Seq.toList
84 | loop [] defs
85 | let children = __.Properties.Values |> flatten
86 | let defs =
87 | __.Properties.Values
88 | |> Seq.choose(function | Ref r -> Some r | _ -> None)
89 | |> Seq.toList
90 | __ :: defs @ children
91 |
92 | and PropertyDefinition =
93 | | Primitive of Type:string*Format:string
94 | | Ref of ObjectDefinition
95 | | Collection of PropertyDefinition
96 | member __.ToJObject() : JObject =
97 | let v = JObject()
98 | match __ with
99 | | Primitive (t,f) ->
100 | v.Add("type", JToken.FromObject t)
101 | v.Add("format", JToken.FromObject f)
102 | | Ref ref ->
103 | v.Add("$ref", JToken.FromObject <| sprintf "#/definitions/%s" ref.Id)
104 | | Collection ref ->
105 | v.Add("type", JToken.FromObject "array")
106 | v.Add("items", ref.ToJObject())
107 | v
108 | member __.ToJson() : string =
109 | __.ToJObject().ToString()
110 | and ParamDefinition =
111 | { Name:string
112 | Type:PropertyDefinition option
113 | In:string
114 | Required:bool }
115 | member __.ToJObject() : JObject =
116 | let v = JObject()
117 | v.Add("name", JToken.FromObject __.Name)
118 | v.Add("in", JToken.FromObject __.In)
119 | v.Add("required", JToken.FromObject __.Required)
120 | match __.Type with
121 | | Some t ->
122 | match t with
123 | | Primitive (t,_) ->
124 | v.Add("type", JToken.FromObject t)
125 | | Ref _ ->
126 | v.Add("schema", t.ToJObject())
127 | | None -> ()
128 | v
129 | member __.ToJson() : string =
130 | __.ToJObject().ToString()
131 |
132 | module TypeHelpers =
133 | //http://swagger.io/specification/ -> Data Types
134 | let typeFormatsNames =
135 | [
136 | typeof, ("string", "string")
137 | typeof, ("integer", "int8")
138 | typeof, ("integer", "int16")
139 | typeof, ("integer", "int32")
140 | typeof, ("integer", "int64")
141 | typeof, ("boolean", "")
142 | typeof, ("float", "float32")
143 | typeof, ("float", "float32")
144 | typeof, ("integer", "int8")
145 | typeof, ("integer", "int16")
146 | typeof, ("integer", "int32")
147 | typeof, ("integer", "int64")
148 | typeof, ("string", "date-time")
149 | typeof, ("string", "binary")
150 | typeof, ("string", "binary")
151 | typeof, ("string", "binary")
152 | typeof, ("string", "byte")
153 | typeof, ("string", "string")
154 | ] |> dict
155 |
156 | type Type with
157 | member this.IsSwaggerPrimitive
158 | with get () =
159 | TypeHelpers.typeFormatsNames.ContainsKey this
160 | member this.FormatAndName
161 | with get () =
162 | match this with
163 | | _ when TypeHelpers.typeFormatsNames.ContainsKey this ->
164 | Some (TypeHelpers.typeFormatsNames.Item this)
165 | | _ when this.IsPrimitive ->
166 | Some (TypeHelpers.typeFormatsNames.Item (typeof))
167 | | _ -> None
168 |
169 | member this.Describes() : ObjectDefinition =
170 |
171 | let optionalType (t:Type) =
172 | if (not t.IsGenericType) || t.GetGenericTypeDefinition() <> typedefof