//! A simple test library.

let string = import! std.string
let { wrap } = import! std.applicative
let { flat_map } = import! std.monad
let float = import! std.float
let int = import! std.int
let list @ { List, ? } = import! std.list
let { Foldable, foldl } = import! std.foldable
let { Option, ? } = import! std.option
let { Result } = import! std.result
let { Semigroup, (<>) } = import! std.semigroup
let { error } = import! std.prim
let { (>>), id } = import! std.function
let { ? } = import! std.io

let { assert } = import! std.assert

let effect @ { Eff, ? } = import! std.effect
let { Writer, run_writer, tell } = import! std.effect.writer
let { Error, run_error } = import! std.effect.error
let { Lift, run_lift } = import! std.effect.lift


type Test r a = Writer (List String) r a
type TestEff r a = Eff [| writer : Test | r |] a
type TestEffIO r a = Eff [| writer : Test, lift : Lift IO | r |] a
type TestCase r a =
    | Test String (() -> Eff [| writer : Test | r |] a)
    | Group String (Array (TestCase r a))

let test = Test
let group = Group

let assert_eq l r : [Show a] -> [Eq a] -> a -> a -> Eff [| writer : Test | r |] () =
    if l == r then wrap ()
    else tell (Cons ("Assertion failed: " <> show l <> " != " <> show r) Nil)

let assert_neq l r : [Show a] -> [Eq a] -> a -> a -> Eff [| writer : Test | r |] () =
    if l /= r then wrap ()
    else tell (Cons ("Assertion failed: " <> show l <> " == " <> show r) Nil)

let assert_lt l r : [Show a] -> [Ord a] -> a -> a -> Eff [| writer : Test | r |] () =
    if l < r then wrap ()
    else tell (Cons ("Assertion failed: " <> show l <> " >= " <> show r) Nil)

let assert_lte l r : [Show a] -> [Ord a] -> a -> a -> Eff [| writer : Test | r |] () =
    if l <= r then wrap ()
    else tell (Cons ("Assertion failed: " <> show l <> " > " <> show r) Nil)

let assert_gt l r : [Show a] -> [Ord a] -> a -> a -> Eff [| writer : Test | r |] () =
    if l > r then wrap ()
    else tell (Cons ("Assertion failed: " <> show l <> " <= " <> show r) Nil)

let assert_gte l r : [Show a] -> [Ord a] -> a -> a -> Eff [| writer : Test | r |] () =
    if l >= r then wrap ()
    else tell (Cons ("Assertion failed: " <> show l <> " < " <> show r) Nil)

let assert_some opt : Option a -> Eff [| writer : Test | r |] () =
    match opt with
    | Some _ -> wrap ()
    | None -> tell (Cons ("Assertion failed: expected Some, found None") Nil)

let assert_none opt : [Show a] -> Option a -> Eff [| writer : Test | r |] () =
    match opt with
    | Some x -> tell (Cons ("Assertion failed: expected None, found " <> show (Some x)) Nil)
    | None -> wrap ()

let assert_ok res : [Show e] -> Result e a -> Eff [| writer : Test | r |] () =
    match res with
    | Ok _ -> wrap ()
    | Err e -> tell (Cons ("Assertion failed: found error: " <> show e) Nil)

let assert_err res : [Show a] -> Result e a -> Eff [| writer : Test | r |] () =
    match res with
    | Ok x -> tell (Cons ("Assertion failed: expected error, found " <> show x) Nil)
    | Err _ -> wrap ()

let assert_success : [Show e]
        -> Eff [| error : Error e, writer : Test | r |] a
        -> Eff [| writer : Test | r |] ()
    =
    run_error >> flat_map assert_ok

let assert_throws : forall e .
        [Show a] -> Eff [| error : Error e, writer : Test | r |] a -> Eff [| writer : Test | r |] ()
    =
    run_error >> flat_map assert_err

rec let run_raw test : Eff [| writer : Test | r |] a -> Eff [| | r |] (List String) =
    do test = run_writer test
    wrap test.writer
in
rec let run test : Eff [| writer : Test | r |] a -> Eff [| | r |] () =
    do writer = run_raw test
    match writer with
    | Cons _ _ -> error (foldl (\acc err -> acc <> "\n" <> err) "" writer)
    | Nil -> wrap ()
in
rec let run_io test : TestEffIO r a -> IO () =
    run_lift (run test)

{
    Test,
    TestEff,
    TestEffIO,
    TestCase,

    test,
    group,

    assert,

    assert_eq,
    assert_neq,
    assert_lt,
    assert_lte,
    assert_gt,
    assert_gte,

    assert_some,
    assert_none,
    assert_ok,
    assert_err,
    assert_success,
    assert_throws,

    run_raw,
    run,
    run_io,
}