option.glu

//@NO-IMPLICIT-PRELUDE
//! A type that can represent the abscence of a value

let { error } = import! std.prim
let { Semigroup } = import! std.semigroup
let { Monoid } = import! std.monoid
let { Eq, Ord, Ordering } = import! std.cmp
let { Functor } = import! std.functor
let { Monad } = import! std.monad
let { Traversable } = import! std.traversable
let { Applicative } = import! std.applicative
let { Alternative } = import! std.alternative
let { Show } = import! std.show
let { Bool } = import! std.bool
let { Option } = import! std.types
let string @ { ? } = import! std.string
let { Foldable } = import! std.foldable
let { (<>) } = import! std.semigroup


let unwrap opt : Option a -> a =
    match opt with
    | Some x -> x
    | None -> error "Option was None"

let former =
    let semigroup : Semigroup (Option a) = {
        append = \l r ->
            match l with
            | Some x -> Some x
            | None -> r,
    }

    let monoid : Monoid (Option a) = {
        semigroup = semigroup,
        empty = None,
    }

    { semigroup, monoid }

let latter =
    let semigroup : Semigroup (Option a) = {
        append = \l r ->
            match r with
            | Some x -> Some x
            | None -> l,
    }

    let monoid : Monoid (Option a) = {
        semigroup = semigroup,
        empty = None,
    }

    { semigroup, monoid }

let semigroup a : Semigroup a -> Semigroup (Option a) = {
    append = \l r ->
        match (l, r) with
        | (Some x, Some y) -> Some (a.append x y)
        | (Some _, None) -> l
        | (None, Some _) -> r
        | (None, None) -> None,
}

let monoid a : Semigroup a -> Monoid (Option a) = {
    semigroup = semigroup a,
    empty = None,
}

let eq ?a : [Eq a] -> Eq (Option a) = {
    (==) = \l r ->
        match (l, r) with
        | (Some l_val, Some r_val) -> a.(==) l_val r_val
        | (None, None) -> True
        | _ -> False,
}

let ord ?a : [Ord a] -> Ord (Option a) =
    {
        eq = eq,
        compare = \l r ->
            match (l, r) with
            | (Some l_val, Some r_val) -> a.compare l_val r_val
            | (None, Some _) -> LT
            | (Some _, None) -> GT
            | (None, None) -> EQ,
    }

let functor : Functor Option = {
    map = \f x ->
        match x with
        | Some y -> Some (f y)
        | None -> None,
}

let applicative : Applicative Option = {
    functor = functor,
    apply = \f x ->
        match (f, x) with
        | (Some g, Some y) -> Some (g y)
        | _ -> None,
    wrap = \x -> Some x,
}

let alternative : Alternative Option = {
    applicative = applicative,
    or = \x y ->
        match x with
        | Some _ -> x
        | None -> y,
    empty = None,
}

let monad : Monad Option = {
    applicative = applicative,
    flat_map = \f m ->
        match m with
        | Some x -> f x
        | None -> None,
}

let show ?d : [Show a] -> Show (Option a) =
    let show o =
        match o with
        | Some x -> "Some (" <> d.show x <> ")"
        | None -> "None"

    { show }

let foldable : Foldable Option = {
    foldr = \f z o ->
        match o with
        | None -> z
        | Some x -> f x z,
    foldl = \f z o ->
        match o with
        | None -> z
        | Some x -> f z x,
}

let traversable : Traversable Option = {
    functor = functor,
    foldable = foldable,
    traverse = \app f o ->
        match o with
        | None -> app.wrap None
        | Some x -> app.functor.map Some (f x),
}

{
    Option,
    unwrap,
    semigroup,
    monoid,
    former,
    latter,
    eq,
    ord,
    functor,
    applicative,
    alternative,
    monad,
    show,
    foldable,
    traversable,
}