aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/error.lux
blob: f05df614d187b76fe6f5f339878133d0e24e10c8 (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
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
(.module:
  [lux #*
   [control
    ["." functor (#+ Functor)]
    [apply (#+ Apply)]
    ["." monad (#+ Monad do)]
    [equivalence (#+ Equivalence)]]])

(type: #export (Error a)
  (#Failure Text)
  (#Success a))

(structure: #export functor (Functor Error)
  (def: (map f ma)
    (case ma
      (#Failure msg)
      (#Failure msg)
      
      (#Success datum)
      (#Success (f datum)))))

(structure: #export apply (Apply Error)
  (def: &functor ..functor)

  (def: (apply ff fa)
    (case ff
      (#Success f)
      (case fa
        (#Success a)
        (#Success (f a))

        (#Failure msg)
        (#Failure msg))

      (#Failure msg)
      (#Failure msg))
    ))

(structure: #export monad (Monad Error)
  (def: &functor ..functor)

  (def: (wrap a)
    (#Success a))

  (def: (join mma)
    (case mma
      (#Failure msg)
      (#Failure msg)
      
      (#Success ma)
      ma)))

(structure: #export (with monad)
  ## TODO: Replace (All [a] (M (Error a))) with (functor.Then M Error)
  (All [M] (-> (Monad M) (Monad (All [a] (M (Error a))))))
  
  (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))

  (def: wrap (|>> (:: ..monad wrap) (:: monad wrap)))
  
  (def: (join MeMea)
    (do monad
      [eMea MeMea]
      (case eMea
        (#Failure error)
        (wrap (#Failure error))

        (#Success Mea)
        Mea))))

(def: #export (lift monad)
  (All [M a] (-> (Monad M) (-> (M a) (M (Error a)))))
  (monad.lift monad (:: ..monad wrap)))

(structure: #export (equivalence (^open "_@."))
  (All [a] (-> (Equivalence a) (Equivalence (Error a))))
  (def: (= reference sample)
    (case [reference sample]
      [(#Success reference) (#Success sample)]
      (_@= reference sample)

      [(#Failure reference) (#Failure sample)]
      ("lux text =" reference sample))))

(def: #export (succeed value)
  (All [a] (-> a (Error a)))
  (#Success value))

(def: #export (fail message)
  (-> Text Error)
  (#Failure message))

(def: #export (assume error)
  (All [a] (-> (Error a) a))
  (case error
    (#Success value)
    value

    (#Failure message)
    (error! message)))

(macro: #export (default tokens compiler)
  {#.doc (doc "Allows you to provide a default value that will be used"
              "if a (Error x) value turns out to be #Failure."
              (= "foo"
                 (default "foo" (#Success "bar")))
              (= "foo"
                 (default "foo" (#Failure "KABOOM!"))))}
  (case tokens
    (^ (list else error))
    (#Success [compiler (list (` (case (~ error)
                                   (#..Success (~' g!temp))
                                   (~' g!temp)

                                   (#..Failure (~ [dummy-cursor (#.Identifier ["" ""])]))
                                   (~ else))))])

    _
    (#Failure "Wrong syntax for default")))