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 | spec = (require 'hifive')!
|
27 | {for-all, data: {Any:BigAny, Array:BigArray, Bool, Int}, sized} = require 'claire'
|
28 | {ok, throws} = require 'assert'
|
29 |
|
30 | _ = require '../../lib'
|
31 | deep-eq = require 'deep-equal'
|
32 | {StaticIdentity:SId, Identity:Id} = require './identity'
|
33 |
|
34 | Any = sized (-> 10), BigAny
|
35 | List = (a) -> sized (-> 10), BigArray(a)
|
36 |
|
37 | id = (a) -> a
|
38 |
|
39 | isnt3 = (a, b, c) -> a !== b and b !== c
|
40 |
|
41 | module.exports = spec 'Monadic Ops' (o, spec) ->
|
42 |
|
43 | o 'concat(a, b) <=> a.concat(b)' do
|
44 | for-all(List(Any), List(Any)).satisfy (a, b) ->
|
45 | _.concat(new Id(a))(new Id(b)).is-equal new Id(a ++ b)
|
46 | .as-test!
|
47 |
|
48 |
|
49 | o 'empty(a) <=> a.empty()' do
|
50 | for-all(Any).satisfy (a) ->
|
51 | _.empty(new Id(a)).is-equal SId.empty() and \
|
52 | _.empty(new SId(a)).is-equal SId.empty()
|
53 | .as-test!
|
54 |
|
55 | o 'map(f, a) <=> a.map(f)' do
|
56 | for-all(Any).satisfy (a) ->
|
57 | _.map(-> [it, it])(new Id(a)).is-equal new Id([a, a])
|
58 | .as-test!
|
59 |
|
60 | o 'of(a, f) <=> f.of(a)' do
|
61 | for-all(Any).satisfy (a) ->
|
62 | _.of(a)(new Id(a)).is-equal new Id(a) and \
|
63 | _.of(a)(SId).is-equal new SId(a)
|
64 | .as-test!
|
65 |
|
66 | o 'ap(a, b) <=> a.ap(b)' do
|
67 | for-all(Any).satisfy (a) ->
|
68 | _.ap(new Id(-> [it, it]))(new Id(a)).is-equal new Id([a, a])
|
69 | .as-test!
|
70 |
|
71 | o 'chain(f, a) <=> a.chain(f)' do
|
72 | for-all(Any).satisfy (a) ->
|
73 | _.chain(-> new Id([it, it]))(new Id(a)).is-equal new Id([a, a])
|
74 | .as-test!
|
75 |
|
76 | o 'sequence(m, ms) should chain monads in ms and collect results.' do
|
77 | for-all(Any, Any, Any).satisfy (a, b, c) ->
|
78 | _.sequence(SId, [new Id(a), new Id(b), new Id(c)]).is-equal new Id([a,b,c])
|
79 | .as-test!
|
80 |
|
81 | o 'sequence(m, ms) should run actions in sequence.' do
|
82 | for-all(Int, Int, Int).satisfy (a, b, c) ->
|
83 | xs = []
|
84 | f = (x) -> { chain: (f) -> xs.push(x); return f(x) }
|
85 | (_.sequence(SId, [f a; f b; f c]).isEqual new Id([a, b, c])) \
|
86 | && (xs `deep-eq` [a, b, c])
|
87 | .as-test!
|
88 |
|
89 | o 'map-m(m, f) <=> sequence m . map f' do
|
90 | for-all(Any, Any, Any).satisfy (a, b, c) ->
|
91 | _.map-m(SId, SId.of, [a, b, c]).is-equal new Id([a, b, c])
|
92 | .as-test!
|
93 |
|
94 | o 'compose(f, g, a) <=> (f a) >>= g' do
|
95 | for-all(Any, Any).given (!==) .satisfy (a, b) ->
|
96 | _.compose(-> new Id([it]))(-> new Id(it ++ [b]))(a)
|
97 | .is-equal new Id([a, b])
|
98 | .as-test!
|
99 |
|
100 | o 'compose-right(g, f, a) <=> compose(f, g, a)' do
|
101 | for-all(Any, Any).given (!==) .satisfy (a, b) ->
|
102 | _.right-compose(-> new Id(it ++ [b]))(-> new Id([it]))(a)
|
103 | .is-equal new Id([a, b])
|
104 | .as-test!
|
105 |
|
106 | o 'join should remove one level of a nested monad' do
|
107 | for-all(Any).satisfy (a) ->
|
108 | _.join(new Id(new Id(a))).is-equal new Id(a)
|
109 | .as-test!
|
110 |
|
111 | o 'filterM of an empty array should yield m []' do
|
112 | for-all(Bool).satisfy (a) ->
|
113 | _.filterM(SId, (-> new Id(a)), []).is-equal new Id([])
|
114 | .as-test!
|
115 |
|
116 | o 'filterM of an array xs for p should only keep items for which p returns m True' do
|
117 | for-all(Bool, List(Any)).satisfy (a, xs) ->
|
118 | _.filterM(SId, (-> new Id(a)), xs).is-equal new Id(xs.filter (-> a))
|
119 | .as-test!
|
120 |
|
121 | o 'lift-m2 should promote a regular binary function to a fn over monads' do
|
122 | for-all(Any, Any).satisfy (a, b) ->
|
123 | _.lift-m2((a, b) -> [a, b])(new Id(a))(new Id(b))
|
124 | .is-equal new Id([a, b])
|
125 | .as-test!
|
126 |
|
127 | o 'lift-mN should promote a N-ary function to a fn over monads' do
|
128 | for-all(List(Any)).given (.length > 1) .satisfy (as) ->
|
129 | _.lift-MN((...bs) -> bs.slice!reverse!)(as.map -> new Id(it))
|
130 | .is-equal new Id(as.slice!reverse!)
|
131 | .as-test!
|
132 |
|
133 | o 'lift-mN should throw an error for lists of length 0' do
|
134 | throws (-> lift-mn id, [])
|
135 |
|
\ | No newline at end of file |