test.fs

open Microsoft.FSharp.Core

open System
open System.Reflection

let mutable errors  = 0

let print (cc : ConsoleColor) (prefix : string) (msg : string) : unit =
  let old = Console.ForegroundColor
  try
    Console.ForegroundColor <- cc
    Console.Write prefix
    Console.WriteLine msg
  finally
    Console.ForegroundColor <- old

let error   msg   = 
  errors <- errors + 1
  print ConsoleColor.Red    "ERROR    : "  msg
let info      msg = print ConsoleColor.Gray   "INFO     : " msg
let warning   msg = print ConsoleColor.Yellow "WARNING  : " msg
let success   msg = print ConsoleColor.Green  "SUCCESS  : " msg
let highlight msg = print ConsoleColor.White  "HIGHLIGHT: " msg

let errorf      fmt = Printf.kprintf error      fmt
let infof       fmt = Printf.kprintf info       fmt
let warningf    fmt = Printf.kprintf warning    fmt
let successf    fmt = Printf.kprintf success    fmt
let highlightf  fmt = Printf.kprintf highlight  fmt

type Expectation<'T> = Expectation of (('T-> unit) -> unit)

let expect_eq (expected : 'T) (actual : 'T) : Expectation<unit> =
  Expectation <| fun a ->
    if expected = actual then
      a ()
    else
      errorf "EQ: %A=%A" expected actual
      a ()

let assert_some (actual : 'T option) : Expectation<'T> =
  Expectation <| fun a ->
    match actual with
    | Some v -> a v
    | _ ->
      error "SOME: None"

module ExpectationMonad =

  let Delay (ft : unit -> Expectation<'T>) : Expectation<'T> =
    ft ()

  let Return v : Expectation<'T> =
    Expectation <| fun a ->
      a v

  let Bind (t : Expectation<'T>) (fu : 'T -> Expectation<'U>) : Expectation<'U> =
    Expectation <| fun uv ->
      let (Expectation tt) = t

      tt (fun vt -> 
        let (Expectation u) = fu vt
        u uv)

  type ExpectationBuilder() =
    member x.Return v     = Return v
    member x.Bind (t,fu)  = Bind t fu
    member x.Delay ft     = Delay ft

let expect = ExpectationMonad.ExpectationBuilder ()

let (>>=) f s = ExpectationMonad.Bind f s

let run (e : Expectation<'T>) : unit =
  let (Expectation ee) = e
  ee (fun _ -> ())


[<AttributeUsage(AttributeTargets.Method)>]
[<AllowNullLiteral>]
type TestAttribute() =
  inherit Attribute()

let runTests () =
  let assembly = Assembly.GetExecutingAssembly ()
  let types = assembly.GetTypes ()

  let methods = 
    types
    |> Seq.collect  (fun t -> t.GetMethods (BindingFlags.Static ||| BindingFlags.Public))
    |> Seq.filter   (fun m -> m.GetCustomAttribute<TestAttribute>() <> null)
    |> Seq.filter   (fun m -> m.GetParameters().Length = 0)
    |> Seq.filter   (fun m -> m.ReturnType = typeof<Void>)
    |> Seq.sortBy   (fun m -> m.Name)
    |> Seq.toArray

  highlightf "Found %d tests" methods.Length

  for meth in methods do
    infof "Running test: %s" meth.Name

    try
      ignore <| meth.Invoke (null, [||])
    with
    | :? TargetInvocationException as e ->
      errorf "  threw exception: %s" e.InnerException.Message
    | e ->
      errorf "  threw exception: %s" e.Message


// -----------------------------------------------------------------------------
// Test code

open M3.HRON.FSharp

open HRON

let simple = """
# This is an ini file using hron

# object values are started with '@'
@Greeting
	=Title
		Hello World from hron!
	=WelcomeMessage
		Hello there!

		String values in hron are started with '='

		Just as in Python, indentation is significant in hron

		Indentation promotes readability but also allows hron string values 
		to be multi-line and relieves them from the need for escaping. 

		Let us say that again, there exists _no_ character escaping in hron. 

		Letters like this are fine in an hron string: &<>\"'@=

		This helps readability!
@DataBaseConnection
	=Name
		CustomerDB
	=ConnectionString
		Data Source=.\SQLEXPRESS;Initial Catalog=Customers
	=TimeOut
		10
	@User
		=UserName
			ATestUser
		=Password
			123
@DataBaseConnection
	=Name
		PartnerDB
	=ConnectionString
		Data Source=.\SQLEXPRESS;Initial Catalog=Partner
	=TimeOut
		30
	@User
		=UserName
			AnotherTestUser
		=Password
			12345"""

let expect_hstring (expected : string) (actual : HRONQuery) = expect_eq expected actual.AsString

[<Test>]
let ``Basic HRON tests`` () : unit = 
  let checkConnection (connection : HRONQuery) dbName connectionString timeOut user pwd =
    expect {
      do! expect_hstring  dbName            (connection ? Name            )
      do! expect_hstring  connectionString  (connection ? ConnectionString)
      do! expect_hstring  timeOut           (connection ? TimeOut         )

      let u = connection ? User
      do! expect_hstring user (u ? UserName)
      do! expect_hstring pwd  (u ? Password)
    }

  expect {
    let! hron = assert_some <| parse simple
    let query = hron.Query

    let greeting = query ? Greeting ? Title
    do! expect_hstring "Hello World from hron!" greeting

    let conns = query ? DataBaseConnection
    do! checkConnection conns     "CustomerDB"  @"Data Source=.\SQLEXPRESS;Initial Catalog=Customers" "10" "ATestUser"        "123"
    do! checkConnection conns.[0] "CustomerDB"  @"Data Source=.\SQLEXPRESS;Initial Catalog=Customers" "10" "ATestUser"        "123"
    do! checkConnection conns.[1] "PartnerDB"   @"Data Source=.\SQLEXPRESS;Initial Catalog=Partner"   "30" "AnotherTestUser"  "12345"

  } |> run


[<EntryPoint>]
let main argv = 
  try
    runTests ()
  with
  | e -> 
    errorf "EXCEPTION: %s" e.Message

  if errors > 0 then
    errorf "%d errors detected" errors
    999
  else
    success "All tests passed"
    0