ruxo
10/13/2015 - 4:26 AM

F# Fundamental libraries

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
        }