Fork me on GitHub

Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
(* This construct is for ML compatibility. The syntax '(typ,...,typ) ident'
is not used in F# code. Consider using 'ident<typ,...,typ>' instead. *)

#nowarn "62"

module Error =

type fromException =
{ message : string
; hresult : int
; stacktrace : string
}

let exn2error : System.Exception -> fromException =
fun ex ->
{ message = ex.Message
; hresult = ex.HResult
; stacktrace = ex.StackTrace
}

module Monad =

(* Inspired by: Eirik Tsarpalis http://fssnip.net/7TF *)

type ('a,'b) flow = ('a,'b) Choice

let success : 'a -> ('a,'b) flow = fun x -> Choice1Of2 x
let failure : 'b -> ('a,'b) flow = fun x -> Choice2Of2 x

let (|Success|Failure|) : ('a,'b) flow -> ('a,'b) flow = id

let catch : (exn -> 'b) -> 'a Async -> ('a,'b) flow Async =
fun f m ->
async {
let! x = Async.Catch m

return
match x with
| Success y -> y |> success
| Failure e -> e |> f |> failure
}

let bind : ('a -> ('c,'b) flow) -> ('a,'b) flow -> ('c,'b) flow =
fun f ->
function
| Success x -> x |> f
| Failure x -> x |> failure

let (>>=) m f = bind f m

module Web =

open Monad

(* Don Syme Blog: "Introducing F# Asynchronous Workflows"

https://blogs.msdn.microsoft.com/dsyme/
2007/10/10/introducing-f-asynchronous-workflows/ *)


open System.IO
open System.Net

type request = GET | POST

let syncHttp : string -> string =
fun url ->
// Create the web request object
let req = WebRequest.Create url

// Get the response, synchronously
let rsp = req.GetResponse ()

// Grab the response stream and a reader. Clean up when we're done
use stream = rsp.GetResponseStream ()
use reader = new StreamReader(stream)

// Synchronous read-to-end, returning the flow
reader.ReadToEnd()

let asyncHttp : string -> string Async =
fun url ->
async {
// Create the web request object
let req = WebRequest.Create url

// Get the response, asynchronously
// let! rsp = req.GetResponseAsync () (* API changes since blog post *)
let! rsp = req.AsyncGetResponse ()

// Grab the response stream and a reader. Clean up when we're done
use stream = rsp.GetResponseStream ()
use reader = new StreamReader(stream)

// synchronous read-to-end
return reader.ReadToEnd ()
}

let asyncHttp' : (exn -> 'a) -> (string * string) list -> request -> string
-> (string,'a) flow Async =
fun error headers request url ->
async {
// Create the web request object
let req = WebRequest.Create url

req.Method <- sprintf "%A" request
req.ContentLength <- 0L
req.Timeout <- System.Threading.Timeout.Infinite

headers
|> List.iter(fun (k,v) -> req.Headers.Add(k,v))

// Get the response, asynchronously
// let! rsp = req.GetResponseAsync () (* API changes since blog post *)
let! rsp = req.AsyncGetResponse ()

// Grab the response stream and a reader. Clean up when we're done
use stream = rsp.GetResponseStream ()
use reader = new StreamReader(stream)

// synchronous read-to-end
return reader.ReadToEnd ()
} |> Monad.catch error

module Translate =

(* https://msdn.microsoft.com/en-us/library/ff512421.aspx *)

open System.Net

open Monad
open Web

type fail = Unexpected of Error.fromException

let inline (=>) x y = x,y

let urlenc : string -> string = WebUtility.UrlEncode

let urlToken = "https://api.cognitive.microsoft.com/sts/v1.0/issueToken"
let urlTrans = "https://api.microsofttranslator.com/v2/Http.svc/Translate"

let token : string -> (string,fail) flow Async =
fun key ->
let headers =
[ "Ocp-Apim-Subscription-Key" => key
]
urlToken |> asyncHttp' (Error.exn2error >> Unexpected) headers POST

let text : string -> string -> string -> string -> (string,fail) flow Async =
fun input fromTag toTag token ->
let query =
sprintf "%s?text=%s&from=%s&to=%s&contentType=text/plain"
urlTrans (urlenc input) fromTag toTag
let headers =
[ "Authorization" => sprintf "Bearer %s" token
]
query |> asyncHttp' (Error.exn2error >> Unexpected) headers GET

open Monad

let apikey = "omitted api key for obvious reasons"

let english = "Use pixels to express measurements for padding and margins."

(* Language Tag: https://msdn.microsoft.com/en-us/library/cc233982.aspx *)
let en = "en"
let da = "da"

Translate.token apikey
|> Async.RunSynchronously
|> function
| Success token ->
Translate.text english en da token
|> Async.RunSynchronously
|> printfn "%A"
| Failure error ->
error
|> printfn "%A"

Code output:

> module Error = begin
type fromException =
{message: string;
hresult: int;
stacktrace: string;}
val exn2error : ex:System.Exception -> fromException
end
module Monad = begin
type ('a,'b) flow = Choice<'a,'b>
val success : x:'a -> ('a,'b) flow
val failure : x:'b -> ('a,'b) flow
val ( |Success|Failure| ) : (('a,'b) flow -> ('a,'b) flow)
val catch : f:(exn -> 'b) -> m:Async<'a> -> Async<('a,'b) flow>
val bind : f:('a -> ('c,'b) flow) -> _arg1:('a,'b) flow -> ('c,'b) flow
val ( >>= ) : m:('a,'b) flow -> f:('a -> ('c,'b) flow) -> ('c,'b) flow
end
module Web = begin
type request =
| GET
| POST
val syncHttp : url:string -> string
val asyncHttp : url:string -> Async<string>
val asyncHttp' :
error:(exn -> 'a) ->
headers:(string * string) list ->
request:request -> url:string -> Async<(string,'a) Monad.flow>
end
module Translate = begin
type fail = | Unexpected of Error.fromException
val inline ( => ) : x:'a -> y:'b -> 'a * 'b
val urlenc : arg00:string -> string
val urlToken : string =
"https://api.cognitive.microsoft.com/sts/v1.0/issueToken"
val urlTrans : string =
"https://api.microsofttranslator.com/v2/Http.svc/Translate"
val token : key:string -> Async<(string,fail) Monad.flow>
val text :
input:string ->
fromTag:string ->
toTag:string -> token:string -> Async<(string,fail) Monad.flow>
end
val apikey : string = "omitted api key for obvious reasons"
val english : string =
"Use pixels to express measurements for padding and margins."
val en : string = "en"
val da : string = "da"

> Choice1Of2
"<string xmlns="http://schemas.microsoft.com/2003/10/Serialization/">
Brug pixel til at udtrykke målinger for polstring og margener.
</string>"
val it : unit = ()

References:

comments powered by Disqus