(.module:
  [lux #*
   [control
    ["F" functor]
    ["A" apply]
    ["M" monad (#+ do Monad)]]])

## [Types]
(type: #export (Error a)
  (#Error Text)
  (#Success a))

## [Structures]
(structure: #export _ (F.Functor Error)
  (def: (map f ma)
    (case ma
      (#Error msg)     (#Error msg)
      (#Success datum) (#Success (f datum)))))

(structure: #export _ (A.Apply Error)
  (def: functor Functor<Error>)

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

        (#Error msg)
        (#Error msg))

      (#Error msg)
      (#Error msg))
    ))

(structure: #export _ (Monad Error)
  (def: functor Functor<Error>)

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

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

(structure: #export (ErrorT Monad<M>)
  (All [M] (-> (Monad M) (Monad (All [a] (M (Error a))))))
  
  (def: functor (F.compose (get@ #M.functor Monad<M>) Functor<Error>))

  (def: wrap (|>> (:: Monad<Error> wrap) (:: Monad<M> wrap)))
  
  (def: (join MeMea)
    (do Monad<M>
      [eMea MeMea]
      (case eMea
        (#Error error)
        (wrap (#Error error))

        (#Success Mea)
        Mea))))

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

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

(def: #export (fail message)
  (All [a] (-> Text (Error a)))
  (#Error message))

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

    (#Error 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 #Error."
              (is? 10
                   (default 20 (#Success 10)))
              (is? 20
                   (default 20 (#Error "KABOOM!"))))}
  (case tokens
    (^ (list else error))
    (#Success [compiler (list (` (case (~ error)
                                   (#..Success (~' g!temp))
                                   (~' g!temp)

                                   (#..Error (~ [dummy-cursor (#.Symbol ["" ""])]))
                                   (~ else))))])

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