From 6284bdc2c7bb793cfba03a2d4a70d9b4f21a76f7 Mon Sep 17 00:00:00 2001 From: Stephane Bortzmeyer Date: Sat, 30 Sep 2023 16:35:07 +0200 Subject: [PATCH] Keep comments in all conversions --- Registry/Utils.hs | 22 ++++++++++++++++------ Registry/Utils/PostgreSQL.hs | 16 ++++++++++------ Registry/Utils/SQLite.hs | 16 ++++++++++------ SQL/PostgreSQL/create-db-subtag.sql | 1 + 4 files changed, 37 insertions(+), 18 deletions(-) diff --git a/Registry/Utils.hs b/Registry/Utils.hs index caf6ee2..971b346 100644 --- a/Registry/Utils.hs +++ b/Registry/Utils.hs @@ -97,15 +97,19 @@ descrToString a = concat (List.intersperse " / " a) prefixesToString a = concat (List.intersperse " / " a) toString (Lang l) = (lang'subtag l) ++ "\t" ++ dateToString (lang'added l) ++ "\t" ++ descrToString (lang'descr l) ++ "\t" ++ - (maybeToString (lang'script l)) ++ "\n" + (maybeToString (lang'script l)) ++ "\t" ++ + (maybeToString (lang'comment l)) ++ "\n" toString (GF t) = (gf'tag t) ++ "\n" toString (Scr s) = (script'subtag s) ++ "\t" ++ dateToString (script'added s) ++ "\t" ++ - descrToString (script'descr s) ++ "\n" + descrToString (script'descr s) ++ "\t" ++ + (maybeToString (script'comment s)) ++ "\n" toString (Reg r) = (region'subtag r) ++ "\t" ++ dateToString (region'added r) ++ "\t" ++ - descrToString (region'descr r) ++ "\n" + descrToString (region'descr r) ++ "\t" ++ + (maybeToString (region'comment r)) ++ "\n" toString (Var v) = (variant'subtag v) ++ "\t" ++ dateToString (variant'added v) ++ "\t" ++ descrToString (variant'descr v) ++ "\t" ++ - prefixesToString (variant'prefix v) ++ "\n" + prefixesToString (variant'prefix v) ++ "\t" ++ + (maybeToString (variant'comment v)) ++ "\n" toString (Red r) = (redundant'tag r) ++ "\t" ++ dateToString (redundant'added r) ++ "\t" ++ descrToString (redundant'descr r) ++ "\n" @@ -114,6 +118,8 @@ dateToXML d = "" ++ d ++ "" addedToXML d = "" ++ d ++ "" deprecatedToXML Nothing = "" deprecatedToXML (Just d) = "" ++ d ++ "" +commentToXML Nothing = "" +commentToXML (Just c) = "" ++ c ++ "" sscriptToXML Nothing = "" sscriptToXML (Just s) = "" ++ s ++ "" prefToXML Nothing = "" @@ -132,6 +138,7 @@ toXML (Lang l) = "" ++ (lang'subtag l) ++ "" ++ descrToXML (lang'descr l) ++ (sscriptToXML (lang'script l)) ++ deprecatedToXML (lang'deprecated l) ++ + commentToXML (lang'comment l) ++ prefToXML (lang'preferredValue l) ++ macrolToXML (lang'macroLanguage l) ++ scopeToXML (lang'scope l) ++ @@ -146,13 +153,16 @@ toXML (Extl l) = "" ++ (extlang'subtag l) ++ "" ++ toXML (GF t) = "" ++ (gf'tag t) ++ "" ++ addedToXML (gf'added t) ++ descrToXML (gf'descr t) ++ "\n" -toXML (Scr s) = "\n" -toXML (Reg r) = "" ++ (region'subtag r) ++ "" ++ +toXML (Reg r) = "" ++ (region'subtag r) ++ "" ++ + commentToXML (region'comment r) ++ addedToXML (region'added r) ++ descrToXML (region'descr r) ++ "\n" toXML (Var v) = "" ++ (variant'subtag v) ++ "" ++ + commentToXML (variant'comment v) ++ addedToXML (variant'added v) ++ descrToXML (variant'descr v) ++ prefixesToXML (variant'prefix v) ++ "\n" diff --git a/Registry/Utils/PostgreSQL.hs b/Registry/Utils/PostgreSQL.hs index 0ecf58e..b76edb1 100644 --- a/Registry/Utils/PostgreSQL.hs +++ b/Registry/Utils/PostgreSQL.hs @@ -10,7 +10,7 @@ escape = concatMap fixChar fixChar c = [c] maybeToPostgreSQL Nothing = "NULL" -maybeToPostgreSQL (Just s) = "'" ++ s ++ "'" +maybeToPostgreSQL (Just s) = "'" ++ (escape s) ++ "'" onedescrToPostgreSQL "language" i s = "INSERT INTO Descriptions (description) " ++ " VALUES ('" ++ (escape s) ++ "');\n" ++ @@ -31,29 +31,33 @@ onedescrToPostgreSQL "variant" i s = "INSERT INTO Descriptions (description) " + descrToPostgreSQL recordtype a i = concat (map (onedescrToPostgreSQL recordtype i) a) toPostgreSQL (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++ - "preferredvalue, added) " ++ + "preferredvalue, comments, added) " ++ "VALUES (" ++ "'" ++ (lang'subtag l) ++ "', " ++ (maybeToPostgreSQL (lang'script l)) ++ ", " ++ - (maybeToPostgreSQL (lang'preferredValue l)) ++ ", " ++ + (maybeToPostgreSQL (lang'preferredValue l)) ++ ", " ++ + (maybeToPostgreSQL (lang'comment l)) ++ ", " ++ "'" ++ (lang'added l) ++ "');\n" ++ (descrToPostgreSQL "language" (lang'descr l) (lang'subtag l)) -toPostgreSQL (Scr s) = "INSERT INTO Scripts (code, added) " ++ +toPostgreSQL (Scr s) = "INSERT INTO Scripts (code, comments, added) " ++ "VALUES (" ++ "'" ++ (script'subtag s) ++ "', " ++ + (maybeToPostgreSQL (script'comment s)) ++ ", " ++ "'" ++ (script'added s) ++ "');\n" ++ (descrToPostgreSQL "script" (script'descr s) (script'subtag s)) -toPostgreSQL (Reg r) = "INSERT INTO Regions (code, added) " ++ +toPostgreSQL (Reg r) = "INSERT INTO Regions (code, comments, added) " ++ "VALUES (" ++ "'" ++ (region'subtag r) ++ "', " ++ + (maybeToPostgreSQL (region'comment r)) ++ ", " ++ "'" ++ (region'added r) ++ "');\n" ++ (descrToPostgreSQL "region" (region'descr r) (region'subtag r)) -toPostgreSQL (Var v) = "INSERT INTO Variants (code, added) " ++ +toPostgreSQL (Var v) = "INSERT INTO Variants (code, comments, added) " ++ "VALUES (" ++ "'" ++ (variant'subtag v) ++ "', " ++ + (maybeToPostgreSQL (variant'comment v)) ++ ", " ++ "'" ++ (variant'added v) ++ "');\n" ++ (descrToPostgreSQL "variant" (variant'descr v) (variant'subtag v)) diff --git a/Registry/Utils/SQLite.hs b/Registry/Utils/SQLite.hs index 4b8ed03..760fd6f 100644 --- a/Registry/Utils/SQLite.hs +++ b/Registry/Utils/SQLite.hs @@ -10,7 +10,7 @@ escape = concatMap fixChar fixChar c = [c] maybeToSQLite Nothing = "NULL" -maybeToSQLite (Just s) = "'" ++ s ++ "'" +maybeToSQLite (Just s) = "'" ++ (escape s) ++ "'" -- TODO: use "SELECT last_insert_rowid();" is probably cleaner than -- "SELECT max(oid)" @@ -33,29 +33,33 @@ onedescrToSQLite "variant" i s = "INSERT INTO Descriptions (description) " ++ descrToSQLite recordtype a i = concat (map (onedescrToSQLite recordtype i) a) toSQLite (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++ - "preferredvalue, added) " ++ + "preferredvalue, comments, added) " ++ "VALUES (" ++ "'" ++ (lang'subtag l) ++ "', " ++ (maybeToSQLite (lang'script l)) ++ ", " ++ - (maybeToSQLite (lang'preferredValue l)) ++ ", " ++ + (maybeToSQLite (lang'preferredValue l)) ++ ", " ++ + (maybeToSQLite (lang'comment l)) ++ ", " ++ "'" ++ (lang'added l) ++ "');\n" ++ (descrToSQLite "language" (lang'descr l) (lang'subtag l)) -toSQLite (Scr s) = "INSERT INTO Scripts (code, added) " ++ +toSQLite (Scr s) = "INSERT INTO Scripts (code, comments, added) " ++ "VALUES (" ++ "'" ++ (script'subtag s) ++ "', " ++ + (maybeToSQLite (script'comment s)) ++ ", " ++ "'" ++ (script'added s) ++ "');\n" ++ (descrToSQLite "script" (script'descr s) (script'subtag s)) -toSQLite (Reg r) = "INSERT INTO Regions (code, added) " ++ +toSQLite (Reg r) = "INSERT INTO Regions (code, comments, added) " ++ "VALUES (" ++ "'" ++ (region'subtag r) ++ "', " ++ + (maybeToSQLite (region'comment r)) ++ ", " ++ "'" ++ (region'added r) ++ "');\n" ++ (descrToSQLite "region" (region'descr r) (region'subtag r)) -toSQLite (Var v) = "INSERT INTO Variants (code, added) " ++ +toSQLite (Var v) = "INSERT INTO Variants (code, comments, added) " ++ "VALUES (" ++ "'" ++ (variant'subtag v) ++ "', " ++ + (maybeToSQLite (variant'comment v)) ++ ", " ++ "'" ++ (variant'added v) ++ "');\n" ++ (descrToSQLite "variant" (variant'descr v) (variant'subtag v)) diff --git a/SQL/PostgreSQL/create-db-subtag.sql b/SQL/PostgreSQL/create-db-subtag.sql index 1842c62..0f63bd6 100644 --- a/SQL/PostgreSQL/create-db-subtag.sql +++ b/SQL/PostgreSQL/create-db-subtag.sql @@ -38,6 +38,7 @@ CREATE TABLE Languages ( preferredvalue TEXT, -- Yes, it should REFERENCES Languages(code), but -- there is a chicken-and-egg problem. added DATE, + deprecated DATE, comments TEXT); CREATE TABLE Extlangs (