match.mml

use (
	. "lists"
	  "functions"
	  "ints"
	  "floats"
)

fn (
	token()      token
	none()       none
	integer()    integer
	floating()   floating
	stringType() stringType
	boolean()    boolean
	errorType()  errorType
)

export fn (
	any()      any
	function() function
	channel()  channel
)

export fn type(t) {
	switch t {
	case int:
		return integer
	case float:
		return floating
	case string:
		return stringType
	case bool:
		return boolean
	case error:
		return errorType
	default:
		return t
	}
}

fn complexType(name) {token: token, type: name}

let (
	intRangeType   complexType("int-range")
	floatRangeType complexType("float-range")
)

fn (
	isRange(ofType, min, max) ofType(min) && ofType(max) && min <= max
	isNaturalRange(min, max)  isRange(isInt, min, max) && min >= 0
)

fn defineRange(ofType, validate, min, max)
	validate(min, max) ?
	{ofType..., min: min, max: max} :
	none

let (
	intRange        defineRange(intRangeType, isRange(isInt))
	floatRange      defineRange(floatRangeType, isRange(isFloat))
	stringRangeType complexType("string")
	stringRange     defineRange(stringRangeType, isNaturalRange)
	listType        complexType("list")
)

fn listRange(item, min, max) {defineRange(listType, isNaturalRange, min, max)..., item: item}

export fn (
	listOf(item) listRange(type(item), 0, ints.max)
	structOf(s)  is({}, s) ? s : none
)

export fn range(match, min, max) {
	let m type(match)
	switch {
	case m == integer:
		return intRange(min, max)
	case m == floating:
		return floatRange(min, max)
	case m == stringType:
		return stringRange(min, max)
	case complexTypeEq(listType, m):
		return listRange(m.item, min, max)
	default:
		return none
	}
}

let (
	unionType     complexType("union")
	intersectType complexType("intersection")
	predicateType complexType("predicate")
)

export fn (
	or(...matches)   {unionType..., matches: map(type, matches)}
	and(...matches)  {intersectType..., matches: map(type, matches)}
	predicate(p)     {predicateType..., predicate: p}
	predicates(...p) and(map(predicate, p)...)
)

fn isSimpleType(t) some(functions.bind(functions.eq, t), [
	integer
	floating
	stringType
	boolean
	function
	errorType
	channel
])

fn isComplexType(t)
	isStruct(t) &&
	has("token", t) && t.token == token &&
	has("type", t) && isString(t.type)

fn isType(t) isSimpleType(t) || isComplexType(t)

fn complexTypeEq(type, value)
	isComplexType(type) &&
	isComplexType(value) &&
	type.type == value.type

let primitives {
	int: {
		checkValue: isInt
		type:       integer
		rangeType:  intRangeType
		rangeValue: functions.identity
	}

	float: {
		checkValue: isFloat
		type:       floating
		rangeType:  floatRangeType
		rangeValue: functions.identity
	}

	string: {
		checkValue: isString
		type:       stringType
		rangeType:  stringRangeType
		rangeValue: len
	}
}

fn matchPrimitive(def, match, value) {
	switch {
	case !def.checkValue(value):
		return false
	case match == def.type:
		return true
	case complexTypeEq(def.rangeType, match):
		let rv def.rangeValue(value)
		return rv >= match.min && rv <= match.max
	default:
		return false
	}
}

let (
	matchInt    matchPrimitive(primitives.int)
	matchFloat  matchPrimitive(primitives.float)
	matchString matchPrimitive(primitives.string)
)

fn matchToList(match, value) {
	if len(value) < len(match) {
		return false
	}

	for i in :len(match) {
		if !is(match[i], value[i]) {
			return false
		}
	}

	return true
}

fn matchToListType(match, value)
	len(value) >= match.min &&
	len(value) <= match.max &&
	(match.item == any || every(is(match.item), value))

fn matchList(match, value) {
	switch {
	case !isList(value):
		return false
	case isList(match):
		return matchToList(match, value)
	case complexTypeEq(listType, match):
		return matchToListType(match, value)
	default:
		return false
	}
}

fn matchStruct(match, value)
	isStruct(value) &&
	every(fn (key) has(key, value) && is(match[key], value[key]), keys(match))

fn (
	matchUnion(match, value)        some(fn (m) is(m, value), match.matches)
	matchIntersection(match, value) every(fn (m) is(m, value), match.matches)
)

fn matchOne(match, value) {
	switch {
	case match == none:
		return false
	case match == any:
		return true
	case complexTypeEq(predicateType, match):
		return match.predicate(value)
	case isType(value) && value != function:
		return false
	case match == value:
		return true
	case match == integer || complexTypeEq(intRangeType, match):
		return matchInt(match, value)
	case match == floating || complexTypeEq(floatRangeType, match):
		return matchFloat(match, value)
	case match == stringType || complexTypeEq(stringRangeType, match):
		return matchString(match, value)
	case match == boolean:
		return isBool(value)
	case match == function:
		return isFunction(value)
	case match == channel:
		return isChannel(value)
	case match == errorType:
		return isError(value)
	case isList(match) || complexTypeEq(listType, match):
		return matchList(match, value)
	case complexTypeEq(unionType, match):
		return matchUnion(match, value)
	case complexTypeEq(intersectType, match):
		return matchIntersection(match, value)
	case isStruct(match):
		return matchStruct(match, value)
	default:
		return false
	}
}

export fn (
	rangeMin(match, min) range(match, min, isInt(min) ? ints.max : float.max)
	listLength(l)        range(listOf(any), l, l)
	not(m)               predicate(fn (v) !is(m, v))
)

export let natural rangeMin(int, 0)

export fn is(match, ...values) len(values) == 0 ? functions.bind(is, match) : every(matchOne(match), values)