-
-
Notifications
You must be signed in to change notification settings - Fork 0
/
core.cljc
115 lines (100 loc) · 3.77 KB
/
core.cljc
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
(ns monnit.core
"A library of Functors, Monads and other category theory abstractions."
#?(:cljs (:require-macros [monnit.core])))
(defprotocol Semigroup
"A type whose values can be combined with an associative binary operation."
(-sconcat [self b] [self b c] [self b c d] [self b c d args]
"Combine `self` with the other arguments, left to right. An implementation
detail, call [[sconcat]] instead."))
(defn sconcat
"Combine the arguments with their [[Semigroup]] combination operation."
([a] a)
([a b] (-sconcat a b))
([a b c] (-sconcat a b c))
([a b c d] (-sconcat a b c d))
([a b c d & args] (-sconcat a b c d args)))
(defprotocol Functor
"A type whose 'contents' can be mapped with a function, producing a new value
of the same type."
(-fmap [a f] [a f b] [a f b c] [a f b c d] [a f b c d args]
"[[fmap]] with the first [[Functor]] value first. An implementation
detail, call [[fmap]] instead."))
(defn fmap
"Map the function `f` over the [[Functor]]-implementing arguments, producing
a new value of the same [[Functor]] type."
([f a] (-fmap a f))
([f a b] (-fmap a f b))
([f a b c] (-fmap a f b c))
([f a b c d] (-fmap a f b c d))
([f a b c d & args] (-fmap a f b c d args)))
(defprotocol Monad
"A type whose 'contents' can be mapped with a function to other values of the containing
type and then combined. When implementing this on a type, you should also implement
[[pure]] for that type."
(bind [self f]
"[[flat-map]], but with the [[Monad]] value first."))
(defn flat-map
"For a [[Monad]] `mv` (of type T<a>), call the function `f` (of type `a -> T<b>`)
on the contained values and combine the results back into on result (of type `T<b>`)."
[f mv]
(bind mv f))
(defmulti pure "Wrap `v` into the [[Monad]] `type`." (fn [type v] type))
(defprotocol Alternative
"A generalization of `or`."
(alt [self other]
"Return `self` unless it is considered a failure; otherwise return `other`."))
#?(:clj
(defmacro mlet
"A convenience macro similar to `let`, `for` and Haskell `do`-notation:
`(mlet [a (foo 0)
b (bar a)
:let [c (+ a b)]]
(pure c))`
=>
`(bind (foo 0)
(fn [a] (bind (bar a)
(fn [b] (let [c (+ a b)]
(pure c))))))`"
[bindings & body]
(assert (vector? bindings) "`bindings` is not a vector")
(assert (zero? (mod (count bindings) 2)) "odd number of `bindings`")
(->> bindings
(partition 2)
reverse
(reduce (fn [body [pat expr]]
(case pat
:let `(let ~expr ~body)
`(bind ~expr (fn [~pat] ~body))))
`(do ~@body)))))
(extend-type #?(:clj clojure.lang.APersistentVector, :cljs PersistentVector)
Semigroup
(-sconcat
([a b] (persistent! (reduce conj! (transient a) b)))
([a b c]
(let [acc (transient a)
acc (reduce conj! acc b)
acc (reduce conj! acc c)]
(persistent! acc)))
([a b c d]
(let [acc (transient a)
acc (reduce conj! acc b)
acc (reduce conj! acc c)
acc (reduce conj! acc d)]
(persistent! acc)))
([a b c d args]
(let [acc (transient a)
acc (reduce conj! acc b)
acc (reduce conj! acc c)
acc (reduce conj! acc d)
acc (reduce (fn [acc arg] (reduce conj! acc arg)) acc args)]
(persistent! acc))))
Functor
(-fmap
([self f] (mapv f self))
([self f b] (mapv f self b))
([self f b c] (mapv f self b c))
([self f b c d] (mapv f self b c d))
([self f b c d args] (apply mapv f self b c d args)))
Monad
(bind [self f] (into [] (mapcat f) self)))
(defmethod pure #?(:clj clojure.lang.APersistentVector, :cljs PersistentVector) [_ v] [v])