Swift Profuctor Optics

SwiftProfunctorHKT.swift

protocol TaggedType {
	associatedtype TagType
}

protocol TypeConstructor1: TaggedType {
	associatedtype ParameterType1
}

protocol TypeConstructor2: TypeConstructor1 {
	associatedtype ParameterType2
}

protocol Profunctor: TypeConstructor2 {
	func dimap <T> (_ onto: T.Type, _ pre: @escaping (T.ParameterType1) -> ParameterType1, _ post: @escaping (ParameterType2) -> T.ParameterType2) -> T where T: Profunctor, T.TagType == TagType
}

struct Function<Source,Target> {
	let call: (Source) -> Target
}

enum FunctionTag {}

extension Function: Profunctor {
	typealias TagType = FunctionTag
	typealias ParameterType1 = Source
	typealias ParameterType2 = Target

	func dimap<T>(_ onto: T.Type, _ pre: @escaping (T.ParameterType1) -> Function<Source, Target>.ParameterType1, _ post: @escaping (Function<Source, Target>.ParameterType2) -> T.ParameterType2) -> T where T : Profunctor, TagType == T.TagType {
		return Function<T.ParameterType1, T.ParameterType2>.init { source in
			post(self.call(pre(source)))
		} as! T
	}
}

enum ForgetTag<T> {}

struct Forget<R, A, B> {
	let run: (A) -> R
}

extension Forget: Profunctor {
	typealias TagType = ForgetTag<R>
	typealias ParameterType1 = A
	typealias ParameterType2 = B

	func dimap<T>(_ onto: T.Type, _ pre: @escaping (T.ParameterType1) -> A, _ post: @escaping (B) -> T.ParameterType2) -> T where T : Profunctor, TagType == T.TagType {
		return Forget<R,T.ParameterType1, T.ParameterType2>.init { source in
			self.run(pre(source))
		} as! T
	}
}

protocol Cartesian: Profunctor {
	func first <OtherProfunctor, Other> (_ onto: OtherProfunctor.Type, _ to: Other.Type) -> OtherProfunctor where OtherProfunctor: Profunctor, OtherProfunctor.TagType == TagType, OtherProfunctor.ParameterType1 == (ParameterType1, Other), OtherProfunctor.ParameterType2 == (ParameterType2, Other)
}

extension Function: Cartesian {
	func first<OtherProfunctor, Other>(_ onto: OtherProfunctor.Type, _ to: Other.Type) -> OtherProfunctor where OtherProfunctor : Profunctor, Function.TagType == OtherProfunctor.TagType, OtherProfunctor.ParameterType1 == (ParameterType1, Other), OtherProfunctor.ParameterType2 == (ParameterType2, Other) {
		return Function<(Source,Other), (Target,Other)>.init { source, other in
			(self.call(source), other)
		} as! OtherProfunctor
	}
}

extension Forget: Cartesian {
	func first<OtherProfunctor, Other>(_ onto: OtherProfunctor.Type, _ to: Other.Type) -> OtherProfunctor where OtherProfunctor : Profunctor, Forget.TagType == OtherProfunctor.TagType, OtherProfunctor.ParameterType1 == (ParameterType1, Other), OtherProfunctor.ParameterType2 == (ParameterType2, Other) {
		return Forget<R,(A,Other),(B,Other)>.init {
			self.run($0.0)
		} as! OtherProfunctor
	}
}

typealias Optic<S,T,A,B,P1,P2> = Function<P1,P2> where P1: Profunctor, P2: Profunctor, P1.TagType == P2.TagType, P1.ParameterType1 == A, P1.ParameterType2 == B, P2.ParameterType1 == S, P2.ParameterType2 == T

typealias Lens<S,T,A,B,P1,P2> = Optic<S,T,A,B,P1,P2> where P1: Cartesian, P2: Cartesian, P1.TagType == P2.TagType, P1.ParameterType1 == A, P1.ParameterType2 == B, P2.ParameterType1 == S, P2.ParameterType2 == T

func lensFirst <A,B,T,P1,P2> (on: (A,B).Type, _ p1: P1.Type, _ p2: P2.Type, _ to: T.Type) -> Lens<(A,B),(T,B),A,T,P1,P2> where P1: Cartesian, P2: Cartesian, P1.TagType == P2.TagType, P1.ParameterType1 == A, P1.ParameterType2 == T, P2.ParameterType1 == (A,B), P2.ParameterType2 == (T,B) {
	return Lens<(A,B),(T,B),A,T,P1,P2>.init { p1 in
		p1.first(P2.self, B.self)
	}
}

let lens1 = lensFirst(on: (Int, Int).self, Function<Int,String>.self, Function<(Int,Int),(String,Int)>.self, String.self)

let setter = lens1.call(Function.init { "\($0)" })

let result1 = setter.call((42,43)) /// gives ("42",43)

let lens2 = lensFirst(on: (Int, Int).self, Forget<Int,Int,String>.self, Forget<Int,(Int,Int),(String,Int)>.self, String.self)

let getter = lens2.call(Forget.init { $0 })

let result2 = getter.run((42,43)) /// gives 42

This code can be copypasted in a Swift playground (Swift 4.1) as is.