#include "TclObject.hh"

#include "CommandException.hh"
#include "Interpreter.hh"

#include "narrow.hh"

namespace openmsx {

[[noreturn]] static void throwException(Tcl_Interp* interp)
{
	std::string_view message = interp ? Tcl_GetStringResult(interp)
	                            : "TclObject error";
	throw CommandException(message);
}

static void unshare(Tcl_Obj*& obj)
{
	if (Tcl_IsShared(obj)) {
		Tcl_DecrRefCount(obj);
		obj = Tcl_DuplicateObj(obj);
		Tcl_IncrRefCount(obj);
	}
}

void TclObject::addListElement(Tcl_Obj* element)
{
	// Although it's theoretically possible that Tcl_ListObjAppendElement()
	// returns an error (e.g. adding an element to a string containing
	// unbalanced quotes), this rarely occurs in our context. So we don't
	// require passing an Interpreter parameter in all addListElement()
	// functions. And in the very unlikely case that it does happen the
	// only problem is that the error message is less descriptive than it
	// could be.
	unshare(obj);
	Tcl_Interp* interp = nullptr;
	if (Tcl_ListObjAppendElement(interp, obj, element) != TCL_OK) {
		throwException(interp);
	}
}

void TclObject::addListElementsImpl(std::initializer_list<Tcl_Obj*> l)
{
	addListElementsImpl(int(l.size()), l.begin());
}

void TclObject::addListElementsImpl(int objc, Tcl_Obj* const* objv)
{
	unshare(obj);
	Tcl_Interp* interp = nullptr; // see comment in addListElement
	if (Tcl_ListObjReplace(interp, obj, INT_MAX, 0, objc, objv) != TCL_OK) {
		throwException(interp);
	}
}

void TclObject::addDictKeyValues(std::initializer_list<Tcl_Obj*> keyValuePairs)
{
	assert((keyValuePairs.size() % 2) == 0);
	unshare(obj);
	Tcl_Interp* interp = nullptr; // see comment in addListElement
	auto it = keyValuePairs.begin(), et = keyValuePairs.end();
	while (it != et) {
		Tcl_Obj* key   = *it++;
		Tcl_Obj* value = *it++;
		if (Tcl_DictObjPut(interp, obj, key, value) != TCL_OK) {
			throwException(interp);
		}
	}
}

int TclObject::getInt(Interpreter& interp_) const
{
	auto* interp = interp_.interp;
	int result;
	if (Tcl_GetIntFromObj(interp, obj, &result) != TCL_OK) {
		throwException(interp);
	}
	return result;
}

int64_t TclObject::getInt64(Interpreter& interp_) const
{
	auto* interp = interp_.interp;
	Tcl_WideInt result;
	if (Tcl_GetWideIntFromObj(interp, obj, &result) != TCL_OK) {
		throwException(interp);
	}
	return int64_t(result);
}

std::optional<int> TclObject::getOptionalInt() const
{
	int result;
	if (Tcl_GetIntFromObj(nullptr, obj, &result) != TCL_OK) {
		return {};
	}
	return result;
}

std::optional<int64_t> TclObject::getOptionalInt64() const
{
	Tcl_WideInt result;
	if (Tcl_GetWideIntFromObj(nullptr, obj, &result) != TCL_OK) {
		return {};
	}
	return int64_t(result);
}

bool TclObject::getBoolean(Interpreter& interp_) const
{
	auto* interp = interp_.interp;
	int result;
	if (Tcl_GetBooleanFromObj(interp, obj, &result) != TCL_OK) {
		throwException(interp);
	}
	return result != 0;
}

std::optional<bool> TclObject::getOptionalBool() const
{
	int result;
	if (Tcl_GetBooleanFromObj(nullptr, obj, &result) != TCL_OK) {
		return {};
	}
	return result != 0;
}

float TclObject::getFloat(Interpreter& interp_) const
{
	// Tcl doesn't directly support 'float', only 'double', so use that.
	// But we hide this from the rest from the code, and we do the
	// narrowing conversion in only this single location.
	return narrow_cast<float>(getDouble(interp_));
}
std::optional<float> TclObject::getOptionalFloat() const
{
	if (auto d = getOptionalDouble()) {
		return narrow_cast<float>(*d);
	}
	return {};
}

double TclObject::getDouble(Interpreter& interp_) const
{
	auto* interp = interp_.interp;
	double result;
	if (Tcl_GetDoubleFromObj(interp, obj, &result) != TCL_OK) {
		throwException(interp);
	}
	return result;
}

std::optional<double> TclObject::getOptionalDouble() const
{
	double result;
	if (Tcl_GetDoubleFromObj(nullptr, obj, &result) != TCL_OK) {
		return {};
	}
	return result;
}

zstring_view TclObject::getString() const
{
	Tcl_Size length;
	const char* buf = Tcl_GetStringFromObj(obj, &length);
	return {buf, size_t(length)};
}

std::span<const uint8_t> TclObject::getBinary(Interpreter& interp_) const
{
	Tcl_Size length;
#if TCL_MAJOR_VERSION >= 9
	auto* interp = interp_.interp;
	const auto* buf = Tcl_GetBytesFromObj(interp, obj, &length);
	if (buf == nullptr) {
		throwException(interp);
	}
#else
	(void)interp_;
	const auto* buf = Tcl_GetByteArrayFromObj(obj, &length);
#endif
	return {buf, size_t(length)};
}

size_t TclObject::getListLength(Interpreter& interp_) const
{
	auto* interp = interp_.interp;
	Tcl_Size result;
	if (Tcl_ListObjLength(interp, obj, &result) != TCL_OK) {
		throwException(interp);
	}
	return result;
}
size_t TclObject::getListLengthUnchecked() const
{
	Tcl_Size result;
	if (Tcl_ListObjLength(nullptr, obj, &result) != TCL_OK) {
		return 0; // error
	}
	return result;
}

TclObject TclObject::getListIndex(Interpreter& interp_, size_t index) const
{
	auto* interp = interp_.interp;
	Tcl_Obj* element;
	if (Tcl_ListObjIndex(interp, obj, narrow<int>(index), &element) != TCL_OK) {
		throwException(interp);
	}
	return element ? TclObject(element) : TclObject();
}
TclObject TclObject::getListIndexUnchecked(size_t index) const
{
	Tcl_Obj* element;
	if (Tcl_ListObjIndex(nullptr, obj, narrow<int>(index), &element) != TCL_OK) {
		return {};
	}
	return element ? TclObject(element) : TclObject();
}

void TclObject::removeListIndex(Interpreter& interp_, size_t index)
{
	unshare(obj);
	auto* interp = interp_.interp;
	if (Tcl_ListObjReplace(interp, obj, narrow<int>(index), 1, 0, nullptr) != TCL_OK) {
		throwException(interp);
	}
}

void TclObject::setDictValue(Interpreter& interp_, const TclObject& key, const TclObject& value)
{
	unshare(obj);
	auto* interp = interp_.interp;
	if (Tcl_DictObjPut(interp, obj, key.obj, value.obj) != TCL_OK) {
		throwException(interp);
	}
}

TclObject TclObject::getDictValue(Interpreter& interp_, const TclObject& key) const
{
	auto* interp = interp_.interp;
	Tcl_Obj* value;
	if (Tcl_DictObjGet(interp, obj, key.obj, &value) != TCL_OK) {
		throwException(interp);
	}
	return value ? TclObject(value) : TclObject();
}

std::optional<TclObject> TclObject::getOptionalDictValue(const TclObject& key) const
{
	Tcl_Obj* value;
	if ((Tcl_DictObjGet(nullptr, obj, key.obj, &value) != TCL_OK) || !value) {
		return {};
	}
	return TclObject(value);
}

bool TclObject::evalBool(Interpreter& interp_) const
{
	auto* interp = interp_.interp;
	int result;
	if (Tcl_ExprBooleanObj(interp, obj, &result) != TCL_OK) {
		throwException(interp);
	}
	return result != 0;
}

TclObject TclObject::eval(Interpreter& interp_) const
{
	auto* interp = interp_.interp;
	Tcl_Obj* result;
	if (Tcl_ExprObj(interp, obj, &result) != TCL_OK) {
		throwException(interp);
	}
	return TclObject(result);
}

TclObject TclObject::executeCommand(Interpreter& interp_, bool compile)
{
	auto* interp = interp_.interp;
	if (int flags = compile ? 0 : TCL_EVAL_DIRECT;
	    Tcl_EvalObjEx(interp, obj, flags) != TCL_OK) {
		throw CommandException(Tcl_GetStringResult(interp));
	}
	return TclObject(Tcl_GetObjResult(interp));
}

} // namespace openmsx