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"

> 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 = ()