hkts in swift

hkt.swift

import Cocoa

protocol HKT {}

struct Nothing {}

struct OptionKind {}
extension OptionKind: HKT {}

struct ResultKind<O> {}
extension ResultKind: HKT {}

enum Lifted<F: HKT,A,B> {
    case Option(item: Option<A>)
    case Result(item: Result<A, B>)
}

enum Option<Item> {
    case Some(item: Item)
    case None
    
    func map<B>(fn: (Item) -> B) -> Option<B> {
        switch self {
            case let .Some(item):
                return Option<B>.Some(item: fn(item))
            case .None:
                return Option<B>.None
        }
    }
    
    func flat_map<B>(fn: (Item) -> Option<B>) -> Option<B> {
        switch self {
        case let .Some(item):
            return fn(item)
        case .None:
            return Option<B>.None
        }
    }
}

extension Option {
    func lift() -> Lifted<OptionKind, Item, Nothing> {
        return Lifted.Option(item: self)
    }
}

extension Lifted where F == OptionKind {
    func unlift() -> Option<A>? {
        switch self {
        case let .Option(item):
            return item
        default:
            return nil
        }
    }
}

enum Result<A, B> {
    case Err(err: B)
    case Ok(ok: A)
    
    func map<C>(fn: (A) -> C) -> Result<C, B> {
        switch self {
        case let .Ok(item):
            return Result<C, B>.Ok(ok: fn(item))
        case let .Err(left):
            return Result<C, B>.Err(err: left)
        }
    }
    
    func flat_map<C>(fn: (A) -> Result<C, B>) -> Result<C,B> {
        switch self {
        case let .Ok(item):
            return fn(item)
        case let .Err(left):
            return Result<C,B>.Err(err: left)
        }
    }
}

extension Result {
    func lift() -> Lifted<ResultKind<B>, A, B> {
        return Lifted.Result(item: self)
    }
}

extension Lifted where F == ResultKind<B> {
    func unlift() -> Result<A, B>? {
        switch self {
        case let .Result(item):
            return item
        default:
            return nil
        }
    }
}


protocol Functor: HKT {
    associatedtype Z
    static func map<A, B>(fa: Lifted<Self, A, Z>, fn: (A) -> B) -> Lifted<Self, B, Z>
}

protocol Applicative: Functor {
    static func ap<A,B>(fa: Lifted<Self, A, Self.Z>, ff: Lifted<Self, (A) -> B, Self.Z>) -> Lifted<Self, B, Self.Z>
    static func point<A>(a: A) -> Lifted<Self, A, Self.Z>
}

extension Applicative {
    static func ap_map<A,B>(fa: Lifted<Self, A, Self.Z>, fn: @escaping (A) -> B) -> Lifted<Self, B, Self.Z> {
        return self.ap(fa: fa, ff: self.point(a: fn))
    }
    
    static func product<A,B>(fa: Lifted<Self, A, Self.Z>, fb: Lifted<Self,B,Self.Z>) -> Lifted<Self,(A,B), Self.Z> {
        let fab: (A) -> (B) -> (A,B) = { a in { b in (a,b) } }
        let fafb = Self.map(fa: fa, fn: fab)
        return Self.ap(fa: fb, ff: fafb)
    }
}

extension OptionKind: Functor {
    typealias Z = Nothing
    
    static func map<A,B>(fa: Lifted<OptionKind, A, Z>, fn: (A) -> B) -> Lifted<OptionKind, B, Z> {
        return fa.unlift()!.map(fn: fn).lift()
    }
}

extension ResultKind: Functor {
    typealias Z = O

    static func map<A,B>(fa: Lifted<ResultKind, A, Z>, fn: (A) -> B) -> Lifted<ResultKind, B, Z> {
        return fa.unlift()!.map(fn: fn).lift()
    }

}

extension OptionKind: Applicative {
    static func ap<A,B>(fa: Lifted<OptionKind, A, Nothing>, ff: Lifted<OptionKind, (A) -> B, Nothing>) -> Lifted<OptionKind, B, Nothing> {
        return ff.unlift()!.flat_map { fa.unlift()!.map(fn: $0)}.lift()
    }
    
    static func point<A>(a: A) -> Lifted<OptionKind, A, OptionKind.Z> {
        return Option.Some(item: a).lift()
    }
}

extension ResultKind: Applicative {
    static func ap<A,B>(fa: Lifted<ResultKind, A, ResultKind.Z>, ff: Lifted<ResultKind, (A) -> B, ResultKind.Z>) -> Lifted<ResultKind, B, ResultKind.Z> {
        return ff.unlift()!.flat_map { fa.unlift()!.map(fn: $0)}.lift()
    }
    
    static func point<A>(a: A) -> Lifted<ResultKind, A, ResultKind.Z> {
        return Result<A, ResultKind.Z>.Ok(ok: a).lift()
    }
}

func takes_applicative<F: Applicative, A, B>(fa: Lifted<F, A, F.Z>, fb: Lifted<F, B, F.Z>) -> Lifted<F, (A,B), F.Z> {
    return F.product(fa: fa, fb: fb)
}

let opt_a = OptionKind.point(a: 1)
let opt_b = OptionKind.point(a: "string")

let res_a = ResultKind<String>.point(a: 1)
let res_b = ResultKind<String>.point(a: "string")

takes_applicative(fa: res_a, fb: res_b).unlift() // Result(ok: (1,"string"))
takes_applicative(fa: opt_a, fb: opt_b).unlift() // Some(item: (1, "string"))