cortav  Diff

-- [ʞ] cortav.lua
--  ~ lexi hale <lexi@hale.su>
--  © AGPLv3
--  ? reference implementation of the cortav document language

local ct = { render = {} }


local function hexdump(s)
	local hexlines, charlines = {},{}
	for i=1,#s do
		local line = math.floor((i-1)/16) + 1
		hexlines[line] = (hexlines[line] or '') .. string.format("%02x ",string.byte(s, i))
		charlines[line] = (charlines[line] or '') .. ' ' .. string.gsub(string.sub(s, i, i), '[^%g ]', '\x1b[;35m·\x1b[36;1m') .. ' '
	end
	local str = ''
	for i=1,#hexlines do
		str = str .. '\x1b[1;36m' .. charlines[i] .. '\x1b[m\n' .. hexlines[i] .. '\n'
	end
	return str
end

local function dump(o, state, path, depth)
	state = state or {tbls = {}}
	depth = depth or 0
	local pfx = string.rep('   ', depth)
	if type(o) == "table" then
		local str = ''
		for k,p in pairs(o) do
			local done = false
			local exp
			if type(p) == 'table' then
				if state.tbls[p] then
					exp = '<' .. state.tbls[p] ..'>'
					done = true
				else
					state.tbls[p] = path and string.format('%s.%s', path, k) or k
				end
			end
			if not done then
				local function dodump() return dump(
					p, state,
					path and string.format("%s.%s", path, k) or k,
					depth + 1
				) end
				-- boy this is ugly
				if type(p) ~= 'table' or
					getmetatable(p) == nil or
					getmetatable(p).__tostring == nil then
					exp = dodump()
				end
				if type(p) == 'table' then
					exp = string.format('{\n%s%s}', exp, pfx)
					local meta = getmetatable(p)
					if meta then
						if meta.__tostring then
							exp = tostring(p)
						end
						if meta.__name then
							exp = meta.__name .. ' ' .. exp
						end
					end
				end
			end
			str = str .. pfx .. string.format("%s = %s\n", k, exp)
		end
		return str
	elseif type(o) == "string" then
		return string.format('“%s”', o)
	else
		return tostring(o)
	end
end

local function
lerp(t, a, b)
	return (1-t)*a + (t*b)
end

local function
startswith(str, pfx)
	return string.sub(str, 1, #pfx) == pfx
end

local function declare(c)
	local cls = setmetatable({
		__name = c.ident;
	}, {
		__name = 'class';
		__tostring = function() return c.ident or '(class)' end;
	})

	cls.__call = c.call
	cls.__index = function(self, k)
		if c.default and c.default[k] then
			return c.default[k]
		end
		if k == 'clone' then
			return function(self)
				local new = cls.mk()
				for k,v in pairs(self) do
					new[k] = v
				end
				if c.clonesetup then
					c.clonesetup(new, self)
				end
				return new
			end
		elseif k == 'to' then
			return function(self, to, ...)
				if to == 'string' then return tostring(self)
				elseif to == 'number' then return tonumber(self)
				elseif to == 'int' then return math.floor(tonumber(self))
				elseif c.cast and c.cast[to] then
					return c.cast[to](self, ...)
				elseif type(to) == 'table' and getmetatable(to) and getmetatable(to).cvt and getmetatable(to).cvt[cls] then
				else error((c.ident or 'class') .. ' is not convertible to ' .. (type(to) == 'string' and to or tostring(to))) end
			end
		end
		if c.fns then return c.fns[k] end
	end

	if c.cast then
		if c.cast.string then
			cls.__tostring = c.cast.string
		end
		if c.cast.number then
			cls.__tonumber = c.cast.number
		end
	end

	cls.mk = function(...)
		local val = setmetatable(c.mk and c.mk(...) or {}, cls)
		if c.init then
			for k,v in pairs(c.init) do
				val[k] = v
			end
		end
		if c.construct then
			c.construct(val, ...)
		end
		return val
	end
	getmetatable(cls).__call = function(_, ...) return cls.mk(...) end
	cls.is = function(o) return getmetatable(o) == cls end
	return cls
end
ct.exn = declare {
	ident = 'exn';
	mk = function(kind, ...)
		return {
			vars = {...};
			kind = kind;
		}
	end;
	cast = {
		string = function(me)
			return me.kind.report(table.unpack(me.vars))
		end;
	};


	fns = {
		throw = function(me) error(me) end;
	}
}
ct.exnkind = declare {
	ident = 'exn-kind';
	mk = function(desc, report)
		return {
			desc = desc;
			report = report or function(msg,...)
				return string.format(msg,...)
			end;
		}
	end;
	call = function(me, ...)
		return ct.exn(me, ...)
	end;
}

ct.exns = {
	tx = ct.exnkind('translation error', function(msg,...)
		return string.format("(%s:%u) "..msg, ...)
	end);
	io = ct.exnkind('IO error', function(msg, ...)
		return string.format("<%s %s> "..msg, ...)
	end);
	cli = ct.exnkind 'command line parse error';
	mode = ct.exnkind('bad mode', function(msg, ...)
		return string.format("mode “%s” "..msg, ...)
	end);
	unimpl = ct.exnkind 'feature not implemented';

}

ct.ctx = declare {
	mk = function(src) return {src = src} end;
	ident = 'context';
	cast = {
		string = function(me)
................................................................................
		secorder = {};
		embed = {};
		meta = {};
		vars = {};
	} end;
}

local function map(fn, lst)
	local new = {}
	for k,v in pairs(lst) do
		table.insert(new, fn(v,k))
	end
	return new
end
local function reduce(fn, acc, lst)
	for i,v in ipairs(lst) do
		acc = fn(acc, v, i)
	end
	return acc
end

local function fmtfn(str)
	return function(...)
		return string.format(str, ...)
	end
end













function ct.render.html(doc, opts)
	local doctitle = opts['title']
	local f = string.format
	local ids = {}
	local canonicalID = {}
	local function getSafeID(obj)
		if canonicalID[obj] then
................................................................................
					end
					table.insert(tb, tag('tr',nil,catenate(row)))
				end
				return tag('table',nil,catenate(tb))
			end;
			listing = function(b,s)
				stylesNeeded.block_code_listing = true
				local nodes = map(function(l)
					if #l > 0 then
						return tag('div',nil,sr.htmlSpan(l, b, s))
					else
						return elt('hr')
					end
				end, b.lines)
				if b.title then
................................................................................
		local r = getSpanRenderers(tag,elt)
		r.block_renderers = getBlockRenderers(tag,elt,r,catenate)
		return r
	end

	local elt = function(t,attrs)
		return f('<%s%s>', t,
			attrs and reduce(function(a,b) return a..b end, '', 
				map(function(v,k)
					if v == true
						then          return ' '..k
						elseif v then return f(' %s="%s"', k, v)
					end
				end, attrs)) or '')
	end
	local tag = function(t,attrs,body)
................................................................................
				return tone(tfg,nil,nil,tonumber(alpha))
			elseif var == 'tone' then
				local l, sep, sat
				for i=1,3 do -- 🙄
					l,sep,sat = param:match('^%('..string.rep('([^%s]*)%s*',i)..'%)$')
					if l then break end
				end
				l = lerp(tonumber(l), tbg, tfg)
				return tone(l, tonumber(sat), tonumber(sep), tonumber(alpha))
			end
		end
		css = css:gsub('@(%w+)/([0-9.]+)(%b())', replace)
		css = css:gsub('@(%w+)(%b())', function(a,b) return replace(a,nil,b) end)
		css = css:gsub('@(%w+)/([0-9.]+)', replace)
		css = css:gsub('@(%w+)', function(a,b) return replace(a,nil,b) end)
................................................................................
	elseif opts.snippet then
		return styletag .. body
	else
		return dr.htmlDoc(doctitle, next(head) and table.concat(head), body)
	end
end

local function eachcode(str, ascode)
	local pos = {
		code = 1;
		byte = 1;
	}
	return function()
		if pos.byte > #str then return nil end
		local thischar = utf8.codepoint(str, pos.byte)
		local lastpos = {
			code = pos.code;
			byte = pos.byte;
			next = pos;
		}
		if not ascode then
			thischar = utf8.char(thischar)
			pos.byte = pos.byte + #thischar
		else
			pos.byte = pos.byte + #utf8.char(thischar)
		end
		pos.code = pos.code + 1
		return thischar, lastpos
	end
end

do -- define span control sequences
	local function formatter(sty)
		return function(s,c)
			return {
				kind = 'format';
				style = sty;
				spans = ct.parse_span(s, c);
................................................................................
				raw = raw;
				var = not pos and s or nil;
				origin = c:clone();
			}
		end
	end
	ct.spanctls = {
		{seq = '$', parse = formatter 'literal'};
		{seq = '!', parse = formatter 'emph'};
		{seq = '*', parse = formatter 'strong'};


		{seq = '\\', parse = function(s, c) -- raw
			return s
		end};
		{seq = '$\\', parse = function(s, c) -- raw
			return {
				kind = 'format';
				style = 'literal';
				spans = {s};
				origin = c:clone();
			}
		end};

		{seq = '&', parse = function(s, c)
			local r, t = s:match '^([^%s]+)%s*(.-)$'
			return {
				kind = 'term';
				spans = (t and t ~= "") and ct.parse_span(t, c) or {};
				ref = r; 
				origin = c:clone();
................................................................................
		{seq = '##', parse = insert_var_ref(true)};
		{seq = '#', parse = insert_var_ref(false)};
	}
end

function ct.parse_span(str,ctx)
	local function delimited(start, stop, s)
		local depth = 0
		if not startswith(s, start) then return nil end
		for c,p in eachcode(s) do
			if c == '\\' then
				p.next.byte = p.next.byte + #utf8.char(utf8.codepoint(s, p.next.byte))
				p.next.code = p.next.code + 1
			elseif c == start then
				depth = depth + 1
			elseif c == stop then
				depth = depth - 1
				if depth == 0 then
					return s:sub(1+#start, p.byte - #stop), p.byte -- FIXME
				elseif depth < 0 then
					ctx:fail('out of place %s', stop)
				end
			end
		end

		ctx:fail('[%s] expected before end of line', stop)
	end
	local buf = ""
	local spans = {}
	local function flush()
		if buf ~= "" then
			table.insert(spans, buf)
			buf = ""
................................................................................
		else
			buf = buf .. c
		end
	end
	flush()
	return spans
end


local function
blockwrap(fn)
	return function(l,c)
		local block = fn(l,c)
		block.origin = c:clone();
		table.insert(c.sec.blocks, block);
................................................................................
	end;
}

local function insert_table_row(l,c)
	local row = {}
	local buf
	local flush = function()


		if buf then table.insert(row, buf) end

		buf = { str = '' }
	end
	for c,p in eachcode(l) do
		if c == '|' or c == '+' and (p.code == 1 or l:sub(p.byte-1,p.byte-1)~='\\') then
			flush()
			buf.header = c == '+'
		elseif c == ':' then
................................................................................
				end
			end
		end
	end

	return ctx.doc
end

local default_mode = {
	['render:format'] = 'html';
	['html:gen-styles'] = true;
}

local function filter(list, fn)
	local new = {}
	for i, v in ipairs(list) do
		if fn(v,i) then table.insert(new, v) end
	end
	return new
end

local function kmap(fn, list)
	local new = {}
	for k, v in pairs(list) do
		local nk,nv = fn(k,v)
		new[nk or k] = nv or v
	end
	return new
end
local function kfilter(list, fn)
	local new = {}
	for k, v in pairs(list) do
		if fn(k,v) then new[k] = v end
	end
	return new
end

local function main(input, output, log, mode, vars)
	local doc = ct.parse(input.stream, input.src, mode)
	input.stream:close()
	if mode['parse:show-tree'] then
		log:write(dump(doc))
	end

	if not mode['render:format'] then
		error 'what output format should i translate the input to?'
	end
	if mode['render:format'] == 'none' then return 0 end
	if not ct.render[mode['render:format']] then
		ct.exns.unimpl('output format “%s” unsupported', mode['render:format']):throw()
	end
	
	local render_opts = kmap(function(k,v)
		return k:sub(2+#mode['render:format'])
	end, kfilter(mode, function(m)
		return startswith(m, mode['render:format']..':')
	end))

	doc.vars = vars
	
	-- this is kind of gross but the context object belongs to the parser,
	-- not the renderer, so that's not a suitable place for this information
	doc.stage = {
		kind = 'render';
		format = mode['render:format'];
		mode = mode;
	}

	output:write(ct.render[mode['render:format']](doc, render_opts))
	return 0
end

local inp,outp,log = io.stdin, io.stdout, io.stderr

local function entry_cli()
	local mode, vars, input = default_mode, {}, {
		stream = inp;
		src = {
			file = '(stdin)';
		}
	}

	local optnparams = function(o)
		local param_opts = {
			out = 1;
			log = 1;
			define = 2; -- key value
			['mode-set'] = 1;
			['mode-clear'] = 1;
			mode = 2;
		}
		return param_opts[o] or 0
	end

	local optmap = {
		o = 'out';
		l = 'log';
		d = 'define';
		V = 'version';
		h = 'help';
		y = 'mode-set', n = 'mode-clear';
		m = 'mode';
	}

	local checkmodekey = function(key)
		if not key:match '[^:]+:.+' then
			ct.exns.cli('invalid mode key %s', key):throw()
		end
		return key
	end
	local onswitch = {
		out = function(file)
			local nf = io.open(file,'wb')
			if nf then outp:close() outp = nf else
				ct.exns.io('could not open output file for writing', 'open',file):throw()
			end
		end;
		log = function(file)
			local nf = io.open(file,'wb')
			if nf then log:close() log = nf else
				ct.exns.io('could not open log file for writing', 'open',file):throw()
			end
		end;
		define = function(key,value)
			if startswith(key, 'cortav.') or startswith(key, 'env.') then
				ct.exns.cli 'cannot define variable in restricted namespace':throw()
			end
			vars[key] = value
		end;
		mode = function(key,value) mode[checkmodekey(key)] = value end;
		['mode-set'] = function(key) mode[checkmodekey(key)] = true end;
		['mode-clear'] = function(key) mode[checkmodekey(key)] = false end;
	}

	local args = {}
	local keepParsing = true
	do local i = 1 while i <= #arg do local v = arg[i]
		local execLongOpt = function(longopt)
			if not onswitch[longopt] then
				ct.exns.cli('switch --%s unrecognized', longopt):throw()
			end
			local nargs = optnparams(longopt)

			if nargs > 1 then
				if i + nargs > #arg then
					ct.exns.cli('not enough arguments for switch --%s (%u expected)', longopt, nargs):throw()
				end
				local nt = {}
				for j = i+1, i+nargs do
					table.insert(nt, arg[j])
				end
				onswitch[longopt](table.unpack(nt))
			elseif nargs == 1 then
				onswitch[longopt](arg[i+1])
			end
			i = i + nargs
		end
		if v == '--' then
			keepParsing = false
		else
			local longopt = v:match '^%-%-(.+)$'
			if keepParsing and longopt then
				execLongOpt(longopt)
			else
				if keepParsing and v:sub(1,1) == '-' then
					for c,p in eachcode(v:sub(2)) do
						if optmap[c] then
							execLongOpt(optmap[c])
						else
							ct.exns.cli('switch -%i unrecognized', c):throw()
						end
					end
				else
					table.insert(args, v)
				end
			end

		end
	i = i + 1 end end

	if args[1] and args[1] ~= '' then
		local file = io.open(arg[1], "rb")
		if not file then error('unable to load file ' .. args[1]) end
		input.stream = file
		input.src.file = args[1]
	end

	return main(input, outp, log, mode, vars)
end

local ok, e = pcall(entry_cli)
-- local ok, e = true, entry_cli()
if not ok then
	local str = 'translation failure'
	if ct.exn.is(e) then
		str = e.kind.desc
	end
	local color = false
	if log:seek() == nil then
		-- this is not a very reliable heuristic for detecting
		-- attachment to a tty but it's better than nothing
		if os.getenv('COLORTERM') then
			color = true
		else
			local term = os.getenv('TERM')
			if term:find 'color' then color = true end
		end
	end
	if color then
		str = string.format('\27[1;31m%s\27[m', str)
	end
	log:write(string.format('%s: %s\n', str, e))
	os.exit(1)
end
os.exit(e)

-- [ʞ] cortav.lua
--  ~ lexi hale <lexi@hale.su>
--  © AGPLv3
--  ? reference implementation of the cortav document language

local ss = require 'sirsem'

-- aliases for commonly used sirsem funcs
local startswith = ss.str.begins
local eachcode = ss.str.enc.utf8.each




















local dump = ss.dump




















































































































local declare = ss.declare












-- make this module available to require() when linked into a lua bytecode program with luac
local ct = ss.namespace 'cortav'
ct.render = {}


















ct.exns = {
	tx = ss.exnkind('translation error', function(msg,...)
		return string.format("(%s:%u) "..msg, ...)
	end);
	io = ss.exnkind('IO error', function(msg, ...)
		return string.format("<%s %s> "..msg, ...)
	end);
	cli = ss.exnkind 'command line parse error';
	mode = ss.exnkind('bad mode', function(msg, ...)
		return string.format("mode “%s” "..msg, ...)
	end);
	unimpl = ss.exnkind 'feature not implemented';
	ext = ss.exnkind 'extension error';
}

ct.ctx = declare {
	mk = function(src) return {src = src} end;
	ident = 'context';
	cast = {
		string = function(me)
................................................................................
		secorder = {};
		embed = {};
		meta = {};
		vars = {};
	} end;
}

-- FP helper functions













local function fmtfn(str)
	return function(...)
		return string.format(str, ...)
	end
end

ct.ext = { loaded = {} }
function ct.ext.install(ext)
	if not ext.id then
		ct.exns.ext 'extension missing “id” field':throw()
	end
	if ct.ext.loaded[ext.id] then
		ct.exns.ext('there is already an extension with ID “%s” loaded', ext.id):throw()
	end
	ct.ext.loaded[ext.id] = ext
end

-- renderer engines
function ct.render.html(doc, opts)
	local doctitle = opts['title']
	local f = string.format
	local ids = {}
	local canonicalID = {}
	local function getSafeID(obj)
		if canonicalID[obj] then
................................................................................
					end
					table.insert(tb, tag('tr',nil,catenate(row)))
				end
				return tag('table',nil,catenate(tb))
			end;
			listing = function(b,s)
				stylesNeeded.block_code_listing = true
				local nodes = ss.map(function(l)
					if #l > 0 then
						return tag('div',nil,sr.htmlSpan(l, b, s))
					else
						return elt('hr')
					end
				end, b.lines)
				if b.title then
................................................................................
		local r = getSpanRenderers(tag,elt)
		r.block_renderers = getBlockRenderers(tag,elt,r,catenate)
		return r
	end

	local elt = function(t,attrs)
		return f('<%s%s>', t,
			attrs and ss.reduce(function(a,b) return a..b end, '', 
				ss.map(function(v,k)
					if v == true
						then          return ' '..k
						elseif v then return f(' %s="%s"', k, v)
					end
				end, attrs)) or '')
	end
	local tag = function(t,attrs,body)
................................................................................
				return tone(tfg,nil,nil,tonumber(alpha))
			elseif var == 'tone' then
				local l, sep, sat
				for i=1,3 do -- 🙄
					l,sep,sat = param:match('^%('..string.rep('([^%s]*)%s*',i)..'%)$')
					if l then break end
				end
				l = ss.math.lerp(tonumber(l), tbg, tfg)
				return tone(l, tonumber(sat), tonumber(sep), tonumber(alpha))
			end
		end
		css = css:gsub('@(%w+)/([0-9.]+)(%b())', replace)
		css = css:gsub('@(%w+)(%b())', function(a,b) return replace(a,nil,b) end)
		css = css:gsub('@(%w+)/([0-9.]+)', replace)
		css = css:gsub('@(%w+)', function(a,b) return replace(a,nil,b) end)
................................................................................
	elseif opts.snippet then
		return styletag .. body
	else
		return dr.htmlDoc(doctitle, next(head) and table.concat(head), body)
	end
end

























do -- define span control sequences
	local function formatter(sty)
		return function(s,c)
			return {
				kind = 'format';
				style = sty;
				spans = ct.parse_span(s, c);
................................................................................
				raw = raw;
				var = not pos and s or nil;
				origin = c:clone();
			}
		end
	end
	ct.spanctls = {

		{seq = '!', parse = formatter 'emph'};
		{seq = '*', parse = formatter 'strong'};
		{seq = '~', parse = formatter 'strike'};
		{seq = '+', parse = formatter 'inser'};
		{seq = '\\', parse = function(s, c) -- raw
			return s
		end};
		{seq = '$\\', parse = function(s, c) -- raw
			return {
				kind = 'format';
				style = 'literal';
				spans = {s};
				origin = c:clone();
			}
		end};
		{seq = '$', parse = formatter 'literal'};
		{seq = '&', parse = function(s, c)
			local r, t = s:match '^([^%s]+)%s*(.-)$'
			return {
				kind = 'term';
				spans = (t and t ~= "") and ct.parse_span(t, c) or {};
				ref = r; 
				origin = c:clone();
................................................................................
		{seq = '##', parse = insert_var_ref(true)};
		{seq = '#', parse = insert_var_ref(false)};
	}
end

function ct.parse_span(str,ctx)
	local function delimited(start, stop, s)
		-- local r = { pcall(ss.str.delimit, 'utf8', start, stop, s) }
		-- if r[1] then return table.unpack(r, 2) end
		-- ctx:fail(tostring(e))
		return ss.str.delimit(ss.str.enc.utf8, start, stop, s)















	end
	local buf = ""
	local spans = {}
	local function flush()
		if buf ~= "" then
			table.insert(spans, buf)
			buf = ""
................................................................................
		else
			buf = buf .. c
		end
	end
	flush()
	return spans
end


local function
blockwrap(fn)
	return function(l,c)
		local block = fn(l,c)
		block.origin = c:clone();
		table.insert(c.sec.blocks, block);
................................................................................
	end;
}

local function insert_table_row(l,c)
	local row = {}
	local buf
	local flush = function()
		if buf then
			buf.str = buf.str:gsub('%s+$','')
			table.insert(row, buf)
		end
		buf = { str = '' }
	end
	for c,p in eachcode(l) do
		if c == '|' or c == '+' and (p.code == 1 or l:sub(p.byte-1,p.byte-1)~='\\') then
			flush()
			buf.header = c == '+'
		elseif c == ':' then
................................................................................
				end
			end
		end
	end

	return ctx.doc
end