Skip to content

Commit bf1bd2a

Browse files
SchlenkRSchlenkR
authored andcommitted
#206 - Enable for- and if-like possibilities
1 parent 64c8448 commit bf1bd2a

2 files changed

Lines changed: 89 additions & 1 deletion

File tree

src/FsHttp/Dsl.CE2.fsx

Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
#r "./bin/Debug/net6.0/FsHttp.dll"
2+
open FsHttp
3+
4+
5+
// ---------
6+
// Builder
7+
// ---------
8+
9+
10+
type HttpBuilder() =
11+
member _.Delay(f: unit -> _) = f ()
12+
13+
member _.Zero() = id
14+
member _.Yield(t: HeaderContext -> HeaderContext) = t
15+
16+
member _.Yield(t: HeaderContext -> BodyContext) = t
17+
member _.Yield(t: BodyContext -> BodyContext) = t
18+
19+
// define header after header
20+
member _.Combine(outer: HeaderContext -> HeaderContext, inner: HeaderContext -> HeaderContext) : HeaderContext -> HeaderContext =
21+
fun hc -> inner (outer hc)
22+
// transition from header to body (using the "body" function)
23+
member _.Combine(outer: HeaderContext -> HeaderContext, inner: HeaderContext -> BodyContext) : HeaderContext -> BodyContext =
24+
fun hc -> inner (outer hc)
25+
// temp. transition "body" to "json"
26+
member _.Combine(outer: HeaderContext -> BodyContext, inner: BodyContext -> BodyContext) : HeaderContext -> BodyContext =
27+
fun hc -> inner (outer hc)
28+
// define body after body
29+
member _.Combine(outer: BodyContext -> BodyContext, inner: BodyContext -> BodyContext) : BodyContext -> BodyContext =
30+
fun hc -> inner (outer hc)
31+
32+
member _.Run(t: HeaderContext -> HeaderContext) =
33+
t (HeaderContext.create ())
34+
member _.Run(t: HeaderContext -> BodyContext) =
35+
t (HeaderContext.create ())
36+
37+
38+
let http = HttpBuilder()
39+
40+
41+
[<AutoOpen>]
42+
module Methods =
43+
let GET url ctx = HeaderContext.setUrl HttpMethods.get url ctx
44+
let PUT url ctx = HeaderContext.setUrl HttpMethods.put url ctx
45+
let POST url ctx = HeaderContext.setUrl HttpMethods.post url ctx
46+
let DELETE url ctx = HeaderContext.setUrl HttpMethods.delete url ctx
47+
let OPTIONS url ctx = HeaderContext.setUrl HttpMethods.options url ctx
48+
let HEAD url ctx = HeaderContext.setUrl HttpMethods.head url ctx
49+
let TRACE url ctx = HeaderContext.setUrl HttpMethods.trace url ctx
50+
let CONNECT url ctx = HeaderContext.setUrl HttpMethods.connect url ctx
51+
let PATCH url ctx = HeaderContext.setUrl HttpMethods.patch url ctx
52+
53+
54+
[<AutoOpen>]
55+
module Header =
56+
/// List of acceptable human languages for response
57+
let AcceptLanguage language ctx =
58+
Header.acceptLanguage language ctx
59+
60+
/// Authorization credentials for HTTP authorization
61+
let Authorization credentials ctx =
62+
Header.authorization credentials ctx
63+
64+
65+
[<AutoOpen>]
66+
module Body =
67+
let body (ctx: HeaderContext) =
68+
(ctx :> IToBodyContext).ToBodyContext()
69+
70+
let json jsonString (ctx: BodyContext) =
71+
Body.json jsonString ctx
72+
73+
74+
75+
76+
77+
78+
let res =
79+
http {
80+
GET "http://www.pxl-clock.com"
81+
AcceptLanguage "en"
82+
Authorization "credOuter"
83+
if true then
84+
Authorization "credInner"
85+
86+
body
87+
json """ { name: "Hans" } """
88+
}

src/FsHttp/Dsl.fs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ module HttpMethods =
2222
let connect = "CONNECT"
2323
let patch = "PATCH"
2424

25-
module internal HeaderContext =
25+
module HeaderContext =
2626
// TODO: I really(!!) have to code the URL stuff on type level;
2727
// this makes problems all over the place; feels like C# :D
2828

0 commit comments

Comments
 (0)