gluon 0.13.1

A static, type inferred programming language for application embedding
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

//! 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_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_ok,
    assert_err,
    assert_success,
    assert_throws,

    run_raw,
    run,
    run_io,
}