F# Fundamental libraries
Compatibility break (since v9): Option and Result extensions are moved to RZ.Fsharp.Extension lib.
// v9
module TiraxTech.Foundation
let inline sideEffect ([<InlineIfLambda>] f) x = (f x); x
let inline flip f a b = f b a
let inline constant x = fun _ -> x
let inline cast<'t> (x :obj) = x :?> 't
let inline tryCast<'a> (x:obj) =
match x with
| :? 'a as s -> Some s
| _ -> None
type System.Object with
member inline o.cast<'T>() = o |> cast<'T>
member inline o.tryCast<'T>() = o |> tryCast<'T>
module Result =
let inline get ([<InlineIfLambda>] right) ([<InlineIfLambda>] wrong) = function
| Ok y -> right y
| Error x -> wrong x
let inline mapAll ([<InlineIfLambda>] fright) ([<InlineIfLambda>] fwrong) = get (Ok << fright) (Error << fwrong)
let inline ap other ([<InlineIfLambda>] fwrong) = get (fun f -> other |> Result.map f) (Error << fwrong)
let inline isError x = x |> get (constant false) (constant true)
let inline isOk x = x |> get (constant true) (constant false)
let inline join r = r |> get id Error
let inline bindAll ([<InlineIfLambda>] f: 'a -> Result<'c,'d>) ([<InlineIfLambda>] fwrong: 'b -> Result<'c,'d>) = get f fwrong
let inline getOrDefault def = get id (constant def)
let inline getOrElse ([<InlineIfLambda>] def) = get id def
let inline mapTask ([<InlineIfLambda>] f: 'a -> Task<'c>) ([<InlineIfLambda>] fwrong: 'b -> 'd) = function
| Ok x -> task {
let! result = f x
return Ok result
}
| Error y -> Task.FromResult <| Error (fwrong y)
let inline bindTask ([<InlineIfLambda>] f: 'a -> Task<Result<'c,'d>>) ([<InlineIfLambda>] fwrong: 'b -> 'd) = function
| Ok x -> f x
| Error y -> Task.FromResult <| Error (fwrong y)
let inline mapAsync ([<InlineIfLambda>] f: 'a -> Async<'c>) ([<InlineIfLambda>] fwrong: 'b -> 'd) = function
| Ok x -> async {
let! result = f x
return Ok result
}
| Error y -> async { return Error (fwrong y) }
let inline bindAsync ([<InlineIfLambda>] f: 'a -> Async<Result<'c,'d>>) ([<InlineIfLambda>] fwrong: 'b -> 'd) = function
| Ok x -> f x
| Error y -> async { return Error (fwrong y) }
// from http://stackoverflow.com/questions/3363184/f-how-to-elegantly-select-and-group-discriminated-unions/11798829#11798829
// let isUnionCase (c : Expr<_ -> 'T>) =
// match c with
// | Lambda (_, NewUnionCase(uci, _)) ->
// let tagReader = Microsoft.FSharp.Reflection.FSharpValue.PreComputeUnionTagReader(uci.DeclaringType)
// fun (v : 'T) -> (tagReader v) = uci.Tag
// | _ -> failwith "Invalid expression"
/// memoizeWithKey: ('input -> 'key) -> ('input -> 'output) -> ('input -> 'output)
let memoizeWithKey (keyGetter: 'input -> 'key) (f: 'input -> 'output) =
let dict = System.Collections.Concurrent.ConcurrentDictionary<'key,'output>()
let memoizedFunc input =
let key = keyGetter input
match dict.TryGetValue key with
| true, x -> x
| false, _ ->
let answer = f input
dict.TryAdd(key, answer) |> ignore
answer
memoizedFunc
let memoize (f: 'a -> 'b) = memoizeWithKey id f
namespace TiraxTech.Net.Mail
open System
open System.Net.Mail
type Email(host, user: string, password: string) =
let smtp = new SmtpClient(host)
do smtp.Credentials <- System.Net.NetworkCredential(user, password)
interface IDisposable with
member x.Dispose() = smtp.Dispose()
member x.send(from, _to, subject, message) =
let mail = new MailMessage(from, _to, subject, message)
async {
let! x = smtp.SendMailAsync(mail) |> Async.AwaitTask
mail.Dispose()
return x
}