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

pub mod functor;
pub mod applicative;
pub mod monad;
pub mod semigroup;
pub mod monoid;
pub mod foldable;
use std::rc::Rc;

pub trait HKT<B> {
  type A; // Current type
  type M; // Type A swapped with B
}

pub trait HKST<'a, B> {
  type A;
  type M;
}

#[macro_export]
macro_rules! derive_hkt {
  ($t:ident) => {
    impl<B, C> HKT<C> for $t<B> {
      type A = B;
      type M = $t<C>;
    }
    impl<'a, B: 'a> HKST<'a, B> for $t<B> {
      type A = &'a B;
      type M = $t<&'a B>;
    }  
  };
}

derive_hkt!(Vec);
derive_hkt!(Option);
derive_hkt!(Box);
derive_hkt!(Rc);

pub trait Functor<B>: HKT<B> {
  fn fmap<F>(&self, f: F) -> Self::M where F: Fn(&Self::A) -> B;
}

pub trait Applicative<B>: Functor<B> {
  fn pure_(value: B) -> Self::M where Self: HKT<B, A=B>;
  fn ap<F>(&self, f: <Self as HKT<F>>::M) -> <Self as HKT<B>>::M
      where F: Fn(&<Self as HKT<B>>::A) -> B, Self:HKT<F>;
}

pub trait Monad<B>: Applicative<B> {
  fn bind<F>(&self, f: F) -> Self::M where F: Fn(&Self::A) -> Self::M;
  fn return_(v: B) -> Self::M where Self: HKT<B, A=B> {
    Self::pure_(v)
  }
  fn fmap<F>(&self, f: F) -> Self::M where F: Fn(&Self::A) -> B, Self: HKT<B, A=B> {
    Self::bind(self, |a| Self::pure_(f(a)))
  }
}

pub trait Semigroup: Clone {
  fn mappend(self: &Self, other: &Self) -> Self;
}

pub trait Monoid: Semigroup {
  fn mempty() -> Self;
}

pub trait FoldableA<'r, A: 'r>: HKST<'r, A> {
  fn fold<F>(self: &'r Self, z: A, f: F) -> A where F: FnMut(A, &A) -> A;
  fn concat<B,F>(self: &'r Self) -> A where A: Monoid { self.fold(A::mempty(), |a,b| A::mappend(&a, b)) }
  fn find<F>(self: &'r Self, f: F) -> Option<&A> where F: Fn(&A) -> bool;
  fn all<F>(self: &'r Self, f: F) -> bool where F: Fn(&A) -> bool;
  fn any<F>(self: &'r Self, f: F) -> bool where F: Fn(&A) -> bool;
  fn filter<F>(self: &'r Self, f: F) -> Self::M where F: Fn(&A) -> bool;
  fn is_empty(self: &'r Self) -> bool;
}

pub trait FoldableB<B>: HKT<B> {
  fn fold_right<F>(&self, z: B, f: F) -> B where F: Fn(&Self::A, B) -> B;
  fn fold_left<F>(&self, z: B, f: F) -> B where F: Fn(B, &Self::A) -> B;
  fn fold_map<F>(&self, f: F) -> B where F: Fn(&Self::A) -> B, B: Monoid { self.fold_left(B::mempty(), |b, a| B::mappend(&b, &f(&a))) }
}

#[allow(unused_macros)]
#[macro_export]
macro_rules! compose {
    ( $last:expr ) => { $last };
    ( $head:expr, $($tail:expr), +) => {
        compose_two($head, compose!($($tail),+))
    };
}

pub fn compose_two<A, B, C, G, F>(f: F, g: G) -> impl Fn(A) -> C
where
    F: Fn(A) -> B,
    G: Fn(B) -> C,
{
    move |x| g(f(x))
}