aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/abstract/apply.lux
blob: 35320cbd4c9805c9b2fd984afe08d0eb0b9d3bbd (plain)
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
(.using
 [library
  [lux (.except)
   ["@" target]]]
 [//
  [monad (.only Monad do)]
  ["[0]" functor (.only Functor)]])

(type: .public (Apply f)
  (Interface
   (is (Functor f)
       functor)
   (is (All (_ a b)
         (-> (f a) (f (-> a b)) (f b)))
       on)))

(def .public (composite f_monad f_apply g_apply)
  (All (_ F G)
    (-> (Monad F) (Apply F) (Apply G)
        ... TODO: Replace (All (_ a) (F (G a))) with (functor.Then F G)
        (Apply (All (_ a) (F (G a))))))
  (implementation
   (def functor
     (functor.composite (the functor f_apply)
                        (the functor g_apply)))
   (def (on fgx fgf)
     ... TODO: Switch from this version to the one below (in comments) ASAP.
     (for @.old (let [fgf' (at f_apply on
                               fgf
                               (at f_monad in (function (_ gf gx) (at g_apply on gx gf))))]
                  (as_expected (at f_apply on (as_expected fgx) (as_expected fgf'))))
          (let [fgf' (at f_apply on
                         fgf
                         (at f_monad in (function (_ gf gx) (at g_apply on gx gf))))]
            (at f_apply on fgx fgf')))
     ... (let [applyF (at f_apply on)
     ...       applyG (at g_apply on)]
     ...   (all applyF
     ...       fgf
     ...       (at f_monad in applyG)
     ...       fgx))
     )))