Módulo:generar-pron/ar

-- ÁRABE
-- Hecho por Tmagc
-- Basado en el módulo de en.wikt para transliterar

local export = {}

local insert = table.insert
local concat = table.concat
local unpack = unpack or table.unpack

local m_str = require("Módulo:String")

local gcodepoint = m_str.gcodepoint
local strfind = m_str.find
local strmatch = m_str.match
local strsubn = m_str.gsub
local strsubb = m_str.gsubb
local strsubrep = m_str.gsub_rep
local strupper = m_str.upper
local strlower = m_str.lower
local strstrip = m_str.strip
local strsplit = m_str.split
local strcount = m_str.count
local strhtml = m_str.encode_html
local u = m_str.char

-- version of strsubn() that discards all but the first return value
local function strsub(term, foo, bar)
	local retval = strsubn(term, foo, bar)
	return retval
end

local ac_primario = u(0x02C8)
local ac_secundario = u(0x02CC)
local acentos_ipa = ac_primario..ac_secundario
local ACENTOS_IPA = ""

local divsil = u(0xFFF0)
local divsil_fijo = u(0xFFF1)
local sepsil = "%-." .. divsil .. divsil_fijo
local SEPARADORES_SILABICOS = ""
local SALVO_SEPARADORES_SILABICOS = ""
local seppal = "# "
local separador_excepto_palabras = acentos_ipa .. sepsil
local separador = separador_excepto_palabras .. seppal
local SEPARADOR = ""

local zwnj = u(0x200C) -- zero-width non-joiner
local alif_madda = u(0x622)
local alif_hamza_below = u(0x625)
local alif = u(0x627)
local taa_marbuuTa = u(0x629)
local laam = u(0x644)
local waaw = u(0x648)
local alif_maqSuura = u(0x649)
local yaa = u(0x64A)
local fatHataan = u(0x64B)
local Dammataan = u(0x64C)
local kasrataan = u(0x64D)
local fatHa = u(0x64E)
local Damma = u(0x64F)
local kasra = u(0x650)
local shadda = u(0x651)
local sukuun = u(0x652)
local dagger_alif = u(0x670)
local alif_waSl = u(0x671)
--local zwj = u(0x200D) -- zero-width joiner
local lrm = u(0x200E) -- left-to-right mark
local rlm = u(0x200F) -- right-to-left mark
-- Occurs after al- in allaḏī and variants so that we can implement elision of
-- a- after a preceding vowel, after which we remove the marker.
local alladi_marker = u(0xFFF0)

local tt = {
	-- consonants
	="b", ="t", ="ṯ", ="j", ="ḥ", ="ḵ",
	="d", ="ḏ", ="r", ="z", ="s", ="š",
	="ṣ", ="ḍ", ="ṭ", ="ẓ", ="ʕ", ="ḡ",
	="f", ="q", ="k", ="k", ="l", ="m", ="n",
	="h",
	-- tāʾ marbūṭa (special) - always after a fátḥa (a), silent at the end of
	-- an utterance, "t" in ʾiḍāfa or with pronounced tanwīn. We catch
	-- most instances of tāʾ marbūṭa before we get to this stage.
	="t", -- tāʾ marbūṭa = ة
	-- control characters
	="-", -- ZWNJ (zero-width non-joiner)
	-- ="", -- ZWJ (zero-width joiner)
	-- rare letters
	="p", ="č", ="ž", ="v", ="v", ="g",
	="g", ="q", ="f", ="n", ="g",
	-- semivowels or long vowels, alif, hamza, special letters
	="ā", -- ʾalif
	-- hamzated letters
	="ʔ", -- hamza over alif
	="ʔ", -- hamza under alif
	="ʔ", -- hamza over wāw
	="ʔ", -- hamza over yā
	="ʔ", -- hamza on the line
	-- long vowels
	="w", --"ū" after ḍamma (u) and not before diacritic
	="y", --"ī" after kasra (i) and not before diacritic
	="ā", -- ʾalif maqṣūra
	="ʔā", -- ʾalif madda
	= "", -- hamzatu l-waṣl
	 = "ā", -- ʾalif xanjariyya = dagger ʾalif (Koranic diacritic)
	-- short vowels, šádda and sukūn
	="an", -- fatḥatan
	="un", -- ḍammatan
	="in", -- kasratan
	="a", -- fatḥa
	="u", -- ḍamma
	="i", -- kasra
	-- šadda - doubled consonant
	="", --sukūn - no vowel
	-- ligatures
	="lā",
	="llāh",
	-- taṭwīl
	="", -- taṭwīl, no sound
	-- numerals
	="1", ="2", ="3", ="4", ="5",
	="6", ="7", ="8", ="9", ="0",
	-- punctuation (leave on separate lines)
	="?", -- question mark
	='“', -- quotation mark
	='”', -- quotation mark
	=".", -- decimal point
	=",", -- thousands separator
	="%", -- percent sign
	=",", -- comma
	=";" -- semicolon
}

local sun_letters = "تثدذرزسشصضطظلن"
-- For use in implementing sun-letter assimilation of ال (al-)
local ttsun1 = {}
local ttsun2 = {}
local ttsun3 = {}
for cp in gcodepoint(sun_letters) do
	local ch = u(cp)
	ttsun1 = tt
	ttsun2 = tt .. "-" .. ch
	table.insert(ttsun3, tt)
end
-- For use in implementing elision of al-
local sun_letters_tr = table.concat(ttsun3, "")

local consonants_needing_vowels = "بتثجحخدذرزسشصضطظعغفقكڪلمنهپچژڤگڨڧڢںڭأإؤئءةﷲ"
-- consonants on the right side; includes alif madda
local rconsonants = consonants_needing_vowels .. "ويآ"
-- consonants on the left side; does not include alif madda
local lconsonants = consonants_needing_vowels .. "وي"
-- Arabic semicolon, comma, question mark; taṭwīl; period, exclamation point,
-- single quote for bold/italic, double quotes for quoted material
local punctuation = "؟،؛" .. "ـ" .. ".!'" .. '"'
local space_like = "%s'" .. '"'
local space_like_class = ""
local numbers = "١٢٣٤٥٦٧٨٩٠"

local PUNTUACION = "%{%}¡!¿?.,;:–—]"
local PUNTUACION_EXTRA = "%{%}¡!¿?.,;:–—\"“”„‟‘’«»»«‹››‹]"

local before_diacritic_checking_subs = {
	------------ transformations prior to checking for diacritics --------------
	-- random Koranic marks and presentation forms
	{u(0x06E1), sukuun}, -- "Small High Dotless Head of Khah" (variant of sukūn)
	{u(0x06DA), ""}, -- "Small High Jeem"
	{u(0x06DF), ""}, -- "Small High Rounded Zero" (FIXME: correct?)
	{u(0x08F0), u(0x64B)}, -- "Open Fathatan"
	{u(0x08F1), u(0x64C)}, -- "Open Dammatan"
	{u(0x08F2), u(0x64D)}, -- "Open Kasratan"
	{u(0x06E4), ""}, -- "Small High Madda" (FIXME: correct?)
	{u(0x06D6), ""}, -- "Small High Ligature Sad with Lam with Alef Maksura" (FIXME: there are others we need to do)
	{u(0x06E5), "و"},
	{u(0x06E6), "ي"},
	-- convert llh for allāh into ll+shadda+dagger-alif+h
	{"لله", "للّٰه"},
	-- shadda+short-vowel (including tanwīn vowels, i.e. -an -in -un) gets
	-- replaced with short-vowel+shadda during NFC normalisation, which
	-- MediaWiki does for all Unicode strings; however, it makes the
	-- transliteration process inconvenient, so undo it.
	{"()" .. shadda, shadda .. "%1"},
	-- ignore Koranic gemination at beginning of word due to assimilation of preceding consonant
	{" ()" .. shadda, " %1"},
	-- ignore alif jamīla (otiose alif in 3pl verb forms)
	--     #1: handle ḍamma + wāw + alif (final -ū)
	{Damma .. waaw .. alif, Damma .. waaw},
	--     #2: handle wāw + sukūn + alif (final -w in -aw in defective verbs)
	--     this must go before the generation of w, which removes the waw here.
	{waaw .. sukuun .. alif, waaw .. sukuun},
	-- ignore final alif or alif maqṣūra following fatḥatan (e.g. in accusative
	-- singular or words like عَصًا "stick" or هُدًى "guidance"; this is called
	-- tanwin nasb)
	{fatHataan .. "", fatHataan},
	-- same but with the fatḥatan placed over the alif or alif maqṣūra
	-- instead of over the previous letter (considered a misspelling but
	-- common)
	{"" .. fatHataan, fatHataan},
	-- tāʾ marbūṭa should always be preceded by fatḥa, alif, alif madda or
	-- dagger alif; infer fatḥa if not
	{"()" .. taa_marbuuTa, "%1" .. fatHa .. taa_marbuuTa},
	-- similarly for alif between consonants, possibly marked with shadda
	-- (does not apply to initial alif, which is silent when not marked with
	-- hamza, or final alif, which might be pronounced as -an)
	{"(" .. shadda .. "?)" .. alif .. "()",
		"%1" .. fatHa .. alif .. "%2"},
	-- infer fatḥa in case of non-fatḥa + alif/alif-maqṣūra + dagger alif
	{"()(" .. dagger_alif .. ")", "%1" .. fatHa .. "%2"},
	-- infer kasra in case of hamza-under-alif not + kasra
	{alif_hamza_below .. "()", alif_hamza_below .. kasra .. "%1"},
	-- ignore dagger alif placed over regular alif or alif maqṣūra
	{"()" .. dagger_alif, "%1"},

	----------- rest of these concern definite article alif-lām ----------
	-- in kasra/ḍamma + alif + lam, make alif into hamzatu l-waṣl, so we
	-- handle cases like بِالتَّوْفِيق (bi-t-tawfīq) correctly
	{"()" .. alif .. laam, "%1" .. alif_waSl .. laam},
	-- al + consonant + shadda (only recognize word-initially if regular alif): remove shadda
	{"^(" .. alif .. fatHa .. "?" .. laam .. ")" .. shadda, "%1"},
	{"(" .. space_like_class .. alif .. fatHa .. "?" .. laam .. ")" .. shadda, "%1"},
	{"(" .. alif_waSl .. fatHa .. "?" .. laam .. ")" .. shadda, "%1"},
	-- handle l- hamzatu l-waṣl or word-initial al-
	{"^" .. alif .. fatHa .. "?" .. laam, "al-"},
	{"(" .. space_like_class .. ")" .. alif .. fatHa .. "?" .. laam, "%1al-"},
	-- next one for bi-t-tawfīq
	{"()" .. alif_waSl .. fatHa .. "?" .. laam, "%1-l-"},
	-- next one for remaining hamzatu l-waṣl (at beginning of word)
	{alif_waSl .. fatHa .. "?" .. laam, "l-"},
	-- special casing if the l in al- has a shadda on it (as in الَّذِي "that"),
	-- so we don't mistakenly double the dash; insert a special marker here so
	-- that we know later to elide the a- after a vowel
	{"l%-" .. shadda, "l" .. alladi_marker .. "l"},
	-- implement assimilation of sun letters
	{"l%-", ttsun2},
}

local has_diacritics_subs = {
	-- FIXME! What about lam-alif ligature?
	-- remove punctuation and shadda
	-- must go before removing final consonants
	{"", ""},
	-- Remove consonants at end of word or utterance, so that we're OK with
	-- words lacking iʿrāb (must go before removing other consonants).
	-- If you want to catch places without iʿrāb, comment out the next two lines.
	{"$", ""},
	{"(}]?" .. space_like_class .. ")", "%1"},
	-- remove consonants (or alif) when followed by diacritics
	-- must go after removing shadda
	-- do not remove the diacritics yet because we need them to handle
	-- long-vowel sequences of diacritic + pseudo-consonant
	{"()", "%1"},
	-- the following two must go after removing consonants w/diacritics because
	-- we only want to treat vocalic wāw/yā' in them (we want to have removed
	-- wāw/yā' followed by a diacritic)
	-- remove ḍamma + wāw
	{Damma .. waaw, ""},
	-- remove kasra + yā'
	{kasra .. yaa, ""},
	-- remove fatḥa/fatḥatan + alif/alif-maqṣūra
	{"", ""},
	-- remove diacritics
	{"", ""},
	-- remove numbers, hamzatu l-waṣl, alif madda
	{"", ""},
	-- remove non-Arabic characters
	{"[^" .. u(0x0600) .. "-" .. u(0x06FF) .. u(0x0750) .. "-" .. u(0x077F) ..
			 u(0x08A0) .. "-" .. u(0x08FF) .. u(0xFB50) .. "-" .. u(0xFDFF) ..
			 u(0xFE70) .. "-" .. u(0xFEFF) .. "]", ""}
}

local function has_diacritics(text)
	local orig_text = text
	local count
	text, count = strsubn(text, "", "")
	if count > 0 then
        require("Módulo:traza")("rlm")
	end
	for _, sub in ipairs(has_diacritics_subs) do
		text = strsub(text, unpack(sub))
	end
	return #text == 0
end


local function transliterar(text)
	for _, sub in ipairs(before_diacritic_checking_subs) do
		text = strsub(text, sub, sub)
	end

	if not has_diacritics(text) then
        error("Texto árabe para transliterar sin diacríticos")
	end

	------------ transformations after checking for diacritics --------------
	-- Replace plain alif with hamzatu l-waṣl when followed by fatḥa/ḍamma/kasra.
	-- Must go after handling of initial al-, which distinguishes alif-fatḥa
	-- from alif w/hamzatu l-waṣl. Must go before generation of ū and ī, which
	-- eliminate the ḍamma/kasra.
	text = strsub(text, alif .. "()", alif_waSl .. "%1")
	-- ḍamma + waw not followed by a diacritic is ū, otherwise w
	text = strsub(text, Damma .. waaw .. "()", "ū%1")
	text = strsub(text, Damma .. waaw .. "$", "ū")
	-- kasra + yaa not followed by a diacritic (or ū from prev step) is ī, otherwise y
	text = strsub(text, kasra .. yaa .. "()", "ī%1")
	text = strsub(text, kasra .. yaa .. "$", "ī")
	-- convert shadda to double letter.
	text = strsub(text, "(.)" .. shadda, "%1%1")

	-- tāʾ marbūṭa should not be rendered by -t if word-final even when
	-- ʾiʿrāb (desinential inflection) is shown; instead, use (t) before
	-- whitespace, nothing when final; but render final -ﺍﺓ and -ﺁﺓ as -āh,
	-- consistent with Wehr's dictionary
	-- Left-to-right or right-to-left mark at end of text will prevent tāʾ marbūṭa
	-- from being transliterated correctly.
	text = string.gsub(text, lrm, "")
	text = string.gsub(text, rlm, "")
	text = strsub(text, "()" .. taa_marbuuTa .. "$", "%1h")
	-- Ignore final tāʾ marbūṭa (it appears as "a" due to the preceding
	-- short vowel). Need to do this after graying or omitting word-final
	-- ʾiʿrāb.
	text = strsub(text, taa_marbuuTa .. "$", "")
	text = strsub(text, taa_marbuuTa .. "(%p)", "%1")
	text = strsub(text, taa_marbuuTa .. "(" .. space_like_class .. ")", "(t)%1")

	-- tatwīl should be rendered as - at beginning or end of word. It will
	-- be rendered as nothing in the middle of a word (FIXME, do we want
	-- this?)
	text = strsub(text, "^ـ", "-")
	text = strsub(text, "(" .. space_like_class .. ")ـ", "%1-")
	text = strsub(text, "ـ$", "-")
	text = strsub(text, "ـ(" .. space_like_class .. ")", "-%1")
	-- Now convert remaining Arabic chars according to table.
	text = strsub(text, ".", tt)
	text = strsub(text, "aā", "ā")
	-- Implement elision of al- after a final vowel. We do this
	-- conservatively, only handling elision of the definite article and related
	-- terms (specifically, relative pronoun الَّذِي (allaḏī) and variants) rather
	-- than elision in other cases of hamzat al-waṣl (e.g. form-I imperatives
	-- or form-VII and above verbal nouns) partly because elision in
	-- these cases isn't so common in MSA and partly to avoid excessive
	-- elision in case of words written with initial bare alif instead of
	-- properly with hamzated alif. Possibly we should reconsider.
	text = strsub(text, "('* +'*)a()",
		"%1%2")

	-- remove indicator of allaḏī, which has served its purpose
	text = strsub(text, alladi_marker, "")
	-- Special-case the transliteration of allāh, without the hyphen.
	text = strsub(text, "^(a?)l%-lāh", "%1llāh")
	text = strsub(text, "(" .. space_like_class .. "a?)l%-lāh", "%1llāh")
	-- Compress multiple spaces, which may occur e.g. when removing Koranic diacritics.
	text = strsub(text, "(%s)%s+", "%1")

	return text
end

local correspondences = {
	 = "ʔ",
	 = "θ",
	 = "d͡ʒ",
	 = "ħ",
	 = "x",
	 = "ð",
	 = "ʃ",
	 = "sˤ",
	 = "dˤ",
	 = "tˤ",
	 = "ðˤ",
	 = "ʒ",
	 = "ʕ",
	 = "ɣ",
	 = "ɫ",
	 = "uː",
	 = "iː",
	 = "aː",
	 = "j",
	 = "ɡ",
	 = "eː",
	 = "oː",
	 = "",
}

local vowels = "aāeēiīoōuū"
local vowel = ""
local long_vowels = "āēīōū"
local long_vowel = ""
local consonant = ""
local syllabify_pattern = "(" .. vowel .. ")(" .. consonant .. "?)(" .. consonant .. "?)(" .. vowel .. ")"
local tie = "‿"
local closed_syllable_shortening_pattern = "(" .. long_vowel .. ")(" .. tie .. ")" .. "(" .. consonant .. ")"

local function silabear(text)
	text = strsubn(text, "%-(" .. consonant .. ")%-(" .. consonant .. ")", "%1.%2")
	text = strsubn(text, "%-", ".")

	-- Add syllable breaks.
	for _ = 1, 2 do
		text = strsubn(
				text,
				syllabify_pattern,
				function(a, b, c, d)
					if c == "" and b ~= "" then
						c, b = b, ""
					end

					return a .. b .. "." .. c .. d
				end
		)
	end

	-- Add ties between word-final vowels and word-initial consonant clusters.
	text = strsubn(text, "(" .. vowel .. ") (" .. consonant .. ")%.?(" ..
			consonant .. ")", "%1" .. tie .. "%2.%3")

	return text
end

local function closed_syllable_shortening(text)
	local shorten = {
		 = "a",
		 = "e",
		 = "i",
		 = "o",
		 = "u",
	}

	text = strsubn(text,
			closed_syllable_shortening_pattern,
			function(vowel_, tie_, consonant_)
				return shorten .. tie_ .. consonant_
			end)

	return text
end

local function normalizar(texto)
	texto = strlower(texto)
	texto = strsubrep(texto, PUNTUACION, " | ") -- convierto lo que delimite fragmentos a los IPA foot boundaries |
	texto = strsubrep(texto, PUNTUACION_EXTRA, "") -- elimino la puntuación restante que haya quedado
	texto = strsubrep(texto, "", " ") --los guiones pasan a ser espacios (austro-húngaro, franco-italiano)
	texto = strsubrep(texto, "־", " ") -- guion hebreo (maqaf)
	texto = strsubrep(texto, "׃", " | ")
	texto = strsubrep(texto, "׀", " | ") -- paseq
	texto = strsubrep(texto, "”", " | ")
	texto = strsubrep(texto, "؟", " | ")
	texto = strsubrep(texto, "،", " | ") -- coma invertida
	texto = strsubrep(texto, "؛", "") -- punto y coma invertido

    texto = strsubrep(texto, "%s*|%s*|%s*", " | ") --finalmente, elimino las barras y espacios de más
    texto = strsubrep(texto, "%s+", " ")
	texto = strstrip(texto, "+")

	return texto
end

local function generar_pron(ss)
	ss = strlower(ss)

    local convertido = {}
	local fragmentos = strsplit(ss, "%s*|%s*")

	for _,fragmento in ipairs(fragmentos) do
	    local palabras = strsplit(fragmento, "%s")
		local palabras_convertidas = {}
        for _,p in ipairs(palabras) do
			-- ACENTUACION: es en la última sílaba larga o en la antepenúltima sílaba si son todas cortas; nunca pasa de la antepenúltima
			local sust
			p, sust = strsubb(p, "^(.*)"..SEPARADORES_SILABICOS.."(.-.-)$", "%1"..ac_primario.."%2")
			if not sust then
				p, sust = strsubb(p, "^(.-.-)$", function(x) return ac_primario.."%1" end)
			end
			if not sust then
				p, sust = strsubb(p, "^(.*)"..SEPARADORES_SILABICOS.."(.-"..SEPARADORES_SILABICOS..".-"..SEPARADORES_SILABICOS..".-)$", "%1"..ac_primario.."%2")
			end
			if not sust then
				p, sust = strsubb(p, "^(.-"..SEPARADORES_SILABICOS..".-"..SEPARADORES_SILABICOS..".-)$", ac_primario.."%1")
			end
			if not sust then -- REVISAR: Qué pasa si una palabra tiene dos sílabas CORTAS ?? Se debería considerar llana??
				p, sust = strsubb(p, "^(.-"..SEPARADORES_SILABICOS..".-)$", ac_primario.."%1")
			end
			p = strsub(p, ".", correspondences)

	    	insert(palabras_convertidas, p)
	    end
	    insert(convertido, concat(palabras_convertidas, " "))
	end

    local fono = concat(convertido, " | ")
    return {{strhtml(fono)}}
end

function export.procesar_pron_args(titulo, args, biblico)
	if not args and not args then
		return args
	end

	if #args < 1 and #args < 1 then
		local rimas, ls = {}, {}
		local tiene_espacios = strfind(titulo, " ")
		local A = #args
		local T = #args
		local j = 1 -- indice de la ayuda
		local k = 1 -- cantidad de pronunciaciones insertadas (máximo 9)
		local t = 1 -- índice de la transliteración
		while k <= 9 and (j <= A or t <= T) do
			local tr = args or transliterar(args)
			args = strhtml(tr)

			-- arreglos no estándar
			tr = normalizar(tr)
			tr = strsub(tr, "llāh", "ḷḷāh")
			tr = strsub(tr, "( ?)ḷḷ", "%1ll")
			-- Remove the transliterations of any tāʾ marbūṭa not marked with a sukūn.
			tr = strsub(tr, "%(t%)", "")
			-- Prodelision after tāʾ marbūṭa
			tr = strsub(tr, "(" .. vowel .. ") " .. vowel, "%1 ")
			tr = strsub(tr, "%-?l%-?", "l")
			tr = silabear(tr)
			tr = closed_syllable_shortening(tr)

			local fono = generar_pron(tr)
			local rim = fono
			rim = strsubn(rim, "^.*"..ac_primario.."(.-)$", "%1")
			rim = strsubn(rim, ".-".."(.*"..")".."$", "%1")
			rimas = true

			if not tiene_espacios then
				local div = strsubn(tr, SEPARADORES_SILABICOS, "-")
				insert(args, div)
				ls = true
			end

			for i,_ in ipairs(fono) do
				if args then
					insert(args, {args})
				end
				insert(args, fono)
				k = k + 1
				if k > 9 then
					break
				end
			end
			j = j + 1
			t = t + 1
		end
		for rim,_ in pairs(rimas) do
			insert(args, rim)
		end
		for lon,_ in pairs(ls) do
			insert(args, lon)
		end
	end

	return args
end

return export