type BaseTyCon = TyConNumber
               | TyConBool
               | TyConUnit
               | TyConList
               | TyConFun
               | TyConTuple
               | TyConUserDefined of string

type TyCon = TyCon of BaseTyCon * Kind

type TyVar = TyVar of string * Kind

type TyExpr = TVarExpr of TyVar
            | TConExpr of TyCon
            | TApExpr of TyExpr * TyExpr
            
type Scheme = Forall of ((TyVar list) * TyExpr)

type Kind = Star | KFun of Kind * Kind

(*
This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.

For more information, please refer to <http://unlicense.org/>
*)

(*
    Nested pairs are very useful when you want to efficiently concatenate strings without
    having to rely on a string builder, which is difficult to use in recursive contexts.
    A string builder is still used internally, but all of the implementation details are hidden.
    
    Example usage taken from F# interactive:
    
    open NestedPair;;
    
    let n = nest [ne "hello"; nest [ne "world"; nest [ne "foo"]]; ne "baz"];;
    val n : NestedPair<string> =
      NestedPair
        (NestedElem "hello",
         NestedPair
           (NestedPair
              (NestedElem "world",
               NestedPair
                 (NestedPair (NestedElem "foo", NestedEmpty), NestedEmpty)),
            NestedPair (NestedElem "baz", NestedEmpty)))
    
    ioListToString n;;
    val it : string = "helloworldfoobaz"
*)

module NestedPair

type NestedPair<'a> = NestedPair of (NestedPair<'a> * NestedPair<'a>)
                    | NestedElem of 'a
                    | NestedEmpty
    
let ne elem =
    NestedElem elem

let rec nest lst =
    match lst with
    | head::tail -> NestedPair (head, nest tail)
    | [] -> NestedEmpty

type IOList = NestedPair<string>

let concat a b =
    NestedPair (a, b)

let rec map f pair =
    match pair with
    | NestedPair (left, right) -> NestedPair ((map f left), (map f right))
    | NestedElem elem -> NestedElem (f elem)
    | NestedEmpty -> NestedEmpty

let rec fold f accum pair =
    match pair with
    | NestedPair (left, right) ->
        let accum' = fold f accum left
        fold f accum' right
    | NestedElem elem ->
        f accum elem
    | NestedEmpty ->
        accum

let rec foldBack f accum pair =
    match pair with
    | NestedPair (left, right) ->
        let accum' = foldBack f accum right
        foldBack f accum' left
    | NestedElem elem ->
        f elem accum
    | NestedEmpty ->
        accum

let ioListToString (lst : IOList) =
    let builder = new System.Text.StringBuilder()
    let rec ioListToString' (lst : IOList) : unit =
        match lst with
        | NestedPair (left, right) ->
            builder.Append(ioListToString' left) |> ignore
            builder.Append(ioListToString' right) |> ignore
        | NestedElem elem ->
            builder.Append(elem) |> ignore
        | NestedEmpty ->
            ()
    ioListToString' lst |> ignore
    builder.ToString()

// val f : (int -> bool)
let f a = a % 2 = 0

// val g : (bool -> string)
let g b = if b then "True" else "False"

// val composed : (int -> string)
let composed = g << f

// > let x = composed 2 ;;
// val e : string = "True"

// > let y = composed 2 ;;
// val y : string = "False"

exception AssertionException of string

module Assert =

    let isTrue value =
        if not value then
            raise (AssertionException "Expected true but got false.")

    let isFalse value =
        if value then
            raise (AssertionException "Expected false but got true.")

    let inline areEqual expected actual =
        if expected <> actual then
            raise (AssertionException ("Expected value '" + string expected + "' but got '" + string actual + "'."))

    let tests1 (ty : Type) =
        let methods = ty.GetMethods (BindingFlags.Instance ||| BindingFlags.Public)
        let instance = Activator.CreateInstance(ty, [||])
        for meth in methods do
            try meth.Invoke(instance, [||]) |> ignore
            with
            | :? AssertionException as exn -> Console.WriteLine ("Test method '" + ty.FullName + "." + meth.Name + "' failed due to: " + string exn)
            | exn -> Console.WriteLine ("Test method '" + ty.FullName + "." + meth.Name + "' unexpectedly exited with exception: " + string exn)

    let tests<'t> () =
        tests1 (typeof<'t>)

type Rect =
  { Left:int; Top:int; Width:int; Height:int }
  with
    static member create(w, h) = { Left=0; Top=0; Width=w; Height=h }
    static member create(l,t,r,b) = { Left=l; Top=t; Width=(r-l)+1; Height=(b-t)+1 }
    static member shrink n r = { Left=r.Left+n; Top=r.Top+n; Width=r.Width-2*n; Height=r.Height-2*n }
    static member scan r =
      seq {
        for y = r.Top to r.Top+r.Height-1 do
          for x = r.Left to r.Left+r.Width-1 do
            yield x,y
      }

open System
open System.Globalization
open FParsec

type Token =
  | KeyGroup of string list
  | KeyValue of string * obj

let (<||>) p1 p2 = attempt (p1 |>> box) <|> attempt (p2 |>> box)
let spc      = many (anyOf [' '; '\t']) 
let lexeme s = pstring s .>> spc
let lexemel s= pstring s .>> spaces
let comment  = pchar '#' .>>. restOfLine false
let blanks   = skipMany ((comment <||> spc) .>> newline .>> spc) .>> spc
let brace p  = between (lexemel "[") (lexemel "]") p
let pbool    = (lexeme "true" >>% true) <|> (lexeme "false" >>% false)
let pstr     = between (lexeme "\"") (lexeme "\"") (manySatisfy ((<>)'"'))
//let pdate' s = try preturn (Instant.FromDateTimeUtc (DateTime.Parse (s, null, DateTimeStyles.RoundtripKind))) with _ -> fail ""
//let pdate    = between spc spc (anyString 20) >>= pdate'
let ary elem = brace (sepBy (elem .>> spaces) (lexemel ","))
let pary     = ary pbool <||> ary pint64 <||> ary pstr <||> ary pfloat
let value    = pbool <||> pstr <||> pint64 <||> pfloat <||> pary <||> ary pary
let kvKey    = many1Chars (noneOf " \t\n=")
let keyvalue = (kvKey .>> spc) .>>. (lexeme "=" >>. value) |>> KeyValue
let kgKey    = (many1Chars (noneOf " \t\n].")) .>> spc
let keygroup = blanks >>. brace (sepBy kgKey (lexeme ".")) |>> KeyGroup
let document = blanks >>. many (keygroup <|> keyvalue .>> blanks)

let parse text : Map<string, obj> =
  match run document text with
  | Success(tokens, _, _) ->
    tokens
    |> List.fold
        (fun (currentKg, m) t ->
         match t with
         | KeyGroup kg -> (kg, m)
         | KeyValue (key, value) ->
           let key = String.concat "." [ yield! currentKg; yield key]
           currentKg, m |> Map.add key value)
        ([], Map.empty)
    |> snd
  | __ -> Map.empty

//invaluable for all those Choice<'a, exn> flows
let exnf f = Printf.ksprintf (fun s -> exn s) f

//combine paths
let (</>) x y = System.IO.Path.Combine(x, y)

//allows you to pattern match on values in the current scope rather than just literals
let (|Eq|_|) expected value =
    if expected = value then Some ()
    else None
//Eq example
let hasKV (m : Map<string, string>) k v =
    match Map.tryFind k m with
    | Some (Eq v) -> true
    | _ -> false

//erlang style pattern matching on maps. This one changes everything. :)
let (|Val|_|) = Map.tryFind
//example
let makeForwarder =
    function
    | Val "type" "db" & Val "connection" conn ->
        dbForwarder conn 
    | Val "type" "console" & Val "prefix" prefix ->
        consoleForwarder prefix
    | _ -> errorForwarder

//TryParse functions are much better used through Active Patterns
let (|AsInt64|_|) s =
    match Int64.TryParse s with
    | true, v -> Some v
    | _ -> None
//example
match "1234" with
| AsInt64 x -> "ok"
| _ -> "not ok"

    

namespace RZ.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
        }

// v2
module RZ.Foundation

open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns

let inline sideEffect f x = (f x); x

let inline flip f a b = f b a
let inline constant x = fun _ -> x

let inline iif t f pred = if pred then t else f

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 Itor =
  open System.Collections.Generic
  let fold :('b -> 'a -> 'b) -> 'b -> IEnumerator<'a> -> 'b = fun reducer init itor ->
    if itor.MoveNext() then
      let mutable v = init
      while itor.MoveNext() do
        v <- reducer v itor.Current
      v
    else
      init

module Seq =
  open System.Collections.Generic
  let fromIterator :IEnumerator<'a> -> 'a seq = fun itor ->
    seq {
      while itor.MoveNext() do
        yield itor.Current
    }

  let tryMin :'a seq -> 'a option = fun ss ->
    let itor = ss.GetEnumerator()
    if itor.MoveNext() then
      Some (itor |> Itor.fold min itor.Current)
    else
      None
  let tryMax :'a seq -> 'a option = fun s ->
    let itor = s.GetEnumerator()
    if itor.MoveNext() then
      Some (itor |> Itor.fold max itor.Current)
    else
      None

module Option =
  let inline ofNullable (x: 'a when 'a : null) =
    match x with
    | null -> None
    | v -> Some v

  let inline cata fnone fsome = function
    | None -> fnone()
    | Some x -> fsome x

  let inline filter predicate opt =
    match opt with
    | None -> None
    | Some v -> if predicate v then opt else None

  let inline getOrDefault def = function
    | Some x -> x
    | None -> def
    
  let inline getOrElse def = function
    | Some x -> x
    | None -> def()

  let join = function
    | None -> None
    | Some x -> x

  let inline do' fsome = cata id fsome
  let inline orTry (fnone: unit -> 'a option) = function
    | None -> fnone()
    | x -> x

  let inline ap other = function
    | None -> None
    | Some f -> other |> Option.map f

  let inline call x = function
    | None -> None
    | Some f -> Some (f x)

open System.Runtime.CompilerServices
[<Extension>]
type OptionExtension =
  [<Extension>] static member inline ap(x: Option<'a -> 'b>, other) = x |> Option.ap other
  [<Extension>] static member inline call(x: Option<'a -> 'b>, p) = x |> Option.call p
  [<Extension>] static member inline join(x: 'a option option) = x |> Option.join

type Option<'a> with
  member inline x.do'(fsome) = x |> Option.do' fsome
  member inline x.filter(predicate) = x |> Option.filter predicate
  member inline x.get() = Option.get x
  member inline x.getOrDefault(def) = x |> Option.getOrDefault def
  member inline x.getOrElse(f) = x |> Option.getOrElse f
  member inline x.orTry(fnone) = x |> Option.orTry fnone

type Result<'a,'b> =
  | Right of 'a
  | Wrong of 'b

module Result =
  let map f = function
    | Wrong x -> Wrong x
    | Right y -> Right (f y)

  let mapAll fright fwrong = function
    | Wrong x -> Wrong (fwrong x)
    | Right y -> Right (fright y)
    
  let inline ap other = function
    | Wrong x -> Wrong x
    | Right f -> other |> map f
    
  let get right wrong = function
    | Wrong x -> wrong x
    | Right y -> right y
    
  let isWrong = function
    | Wrong _ -> true
    | Right _ -> false

  let isRight x = not <| isWrong x
  let join = function
    | Wrong x -> Wrong x
    | Right y -> y

  let bind f x = get f Wrong x

  let getOrElse def f = get f (fun _ -> def)


type ResultBuilder() =
  member __.Bind(x: Result<'a,'b>, f: 'a -> Result<'c,'b>) = Result.bind f x
  member __.Return(v: 'c) = Right v 
  member __.ReturnFrom(v: Result<'a,'b>) = v
  member __.Using(v: 'a, f: 'a -> Result<'b,'c>) :Result<'b,'c> = f v
  member __.Delay(f: unit -> Result<'a,'b>) = f
  member __.Run(f: unit -> Result<'a,'b>) = f()
  member __.TryWith(f: unit -> Result<'a,'b>, catch: exn -> Result<'a,'b>) = 
    try
      f()
    with
    | e -> catch e

let either = ResultBuilder()


// 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

type StrRef =
  { str: string
    start: int
    length: int }

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module StrRef =
  let substring n s = { s with length=(min s.length n) }
  let lastPos sr = sr.start + sr.length - 1
  let iterate sr =
    seq {
      for i = sr.start to (lastPos sr) do
        yield sr.str.[i]
    }

  let equals (s: string) sr = s.Length = sr.length && (Seq.forall id ((=) <!> iterate sr <*> s))
  let skip n sr = { sr with start = (min (lastPos sr) (sr.start+n))
                            length= (max 0 (sr.length - n))}