bortzmeyer/GaBuZoMeu
1
0
Fork 1
Code Issues 7 Pull Requests Projects Releases Wiki Activity

Keep comments in all conversions

Browse Source
This commit is contained in:
Stephane Bortzmeyer 2023-09-30 16:35:07 +02:00
parent b6101769a2
commit 6284bdc2c7
4 changed files with 37 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
Registry/Utils.hs
View File

@ -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 = "<date>" ++ d ++ "</date>"
addedToXML d = "<added>" ++ d ++ "</added>"
deprecatedToXML Nothing = ""
deprecatedToXML (Just d) = "<deprecated>" ++ d ++ "</deprecated>"
commentToXML Nothing = ""
commentToXML (Just c) = "<comments>" ++ c ++ "</comments>"
sscriptToXML Nothing = ""
sscriptToXML (Just s) = "<suppress-script>" ++ s ++ "</suppress-script>"
prefToXML Nothing = ""
@ -132,6 +138,7 @@ toXML (Lang l) = "<language><subtag>" ++ (lang'subtag l) ++ "</subtag>" ++
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>" ++ (extlang'subtag l) ++ "</subtag>" ++
toXML (GF t) = "<grandfathered><tag>" ++ (gf'tag t) ++ "</tag>" ++
addedToXML (gf'added t) ++
descrToXML (gf'descr t) ++ "</grandfathered>\n"
toXML (Scr s) = "<script><subtag>" ++ (script'subtag s) ++ "</subtag>" ++
toXML (Scr s) = "<script><subtag>" ++ (script'subtag s) ++ "</subtag>" ++
commentToXML (script'comment s) ++
addedToXML (script'added s) ++
descrToXML (script'descr s) ++ "</script>\n"
toXML (Reg r) = "<region><subtag>" ++ (region'subtag r) ++ "</subtag>" ++
toXML (Reg r) = "<region><subtag>" ++ (region'subtag r) ++ "</subtag>" ++
commentToXML (region'comment r) ++
addedToXML (region'added r) ++
descrToXML (region'descr r) ++ "</region>\n"
toXML (Var v) = "<variant><subtag>" ++ (variant'subtag v) ++ "</subtag>" ++
commentToXML (variant'comment v) ++
addedToXML (variant'added v) ++
descrToXML (variant'descr v) ++
prefixesToXML (variant'prefix v) ++ "</variant>\n"

16
Registry/Utils/PostgreSQL.hs
View File

@ -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))

16
Registry/Utils/SQLite.hs
View File

@ -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))

1
SQL/PostgreSQL/create-db-subtag.sql
View File

@ -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 (