//! Implementation of the `Error` effect

let { Eff, inject_rest, ? } = import! std.effect
let { Result } = import! std.result
let { Option } = import! std.option
let { (<<) } = import! std.function
let { wrap } = import! std.applicative

/// The `Error` effects adds "exceptions" to the `Eff` monad
type Error e r a =
    | Error e
    .. r

let send_error f : Error e r a -> Eff [| error : Error e | r |] a =
    Impure (convert_effect! error f) Pure

let extract_error x : forall e . [| error : Error e | r |] a -> Error e r a = convert_variant! x

/// Throws the error `e`
let throw e : e -> Eff [| error : Error e | r |] a = send_error (Error e)

/// Moves a `Result` into the `Eff` monad
let ok_or_throw r : Result e t -> Eff [| error : Error e | r |] t =
    match r with
    | Ok t -> wrap t
    | Err e -> throw e

let some_or_throw e o : e -> Option a -> Eff [| error : Error e | r |] a =
    match o with
    | Some x -> wrap x
    | None -> throw e

/// Eliminates the `Error` effect and returns a `Result`
let run_error eff : forall e . Eff [| error : Error e | r |] a -> Eff [| | r |] (Result e a) =
    let loop ve : Eff [| error : Error e | r |] a -> Eff [| | r |] (Result e a) =
        match ve with
        | Pure v -> wrap (Ok v)
        | Impure e f ->
            match extract_error e with
            | Error err ->
                wrap (Err err)
            | rest ->
                Impure (inject_rest rest) (loop << f)
    loop eff

/// Catches an "exception", allowing the effect to continue executing
let catch eff handler : forall e .
        Eff [| error : Error e | r |] a
            -> (e -> Eff [| error : Error e | r |] a)
            -> Eff [| error : Error e | r |] a
    =
    let loop ve : Eff [| error : Error e | r |] a -> Eff [| error : Error e | r |] a =
        match ve with
        | Pure v -> wrap v
        | Impure e f ->
            match extract_error e with
            | Error err ->
                handler err
            | rest ->
                Impure e (loop << f)
    loop eff


{
    Error,

    catch,
    throw,
    ok_or_throw,
    some_or_throw,
    run_error,
}