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) prefixesToString a = concat (List.intersperse " / " a)
toString (Lang l) = (lang'subtag l) ++ "\t" ++ dateToString (lang'added l) ++ "\t" ++ toString (Lang l) = (lang'subtag l) ++ "\t" ++ dateToString (lang'added l) ++ "\t" ++
descrToString (lang'descr 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 (GF t) = (gf'tag t) ++ "\n"
toString (Scr s) = (script'subtag s) ++ "\t" ++ dateToString (script'added s) ++ "\t" ++ 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" ++ 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" ++ toString (Var v) = (variant'subtag v) ++ "\t" ++ dateToString (variant'added v) ++ "\t" ++
descrToString (variant'descr 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" ++ toString (Red r) = (redundant'tag r) ++ "\t" ++ dateToString (redundant'added r) ++ "\t" ++
descrToString (redundant'descr r) ++ "\n" descrToString (redundant'descr r) ++ "\n"
@ -114,6 +118,8 @@ dateToXML d = "<date>" ++ d ++ "</date>"
addedToXML d = "<added>" ++ d ++ "</added>" addedToXML d = "<added>" ++ d ++ "</added>"
deprecatedToXML Nothing = "" deprecatedToXML Nothing = ""
deprecatedToXML (Just d) = "<deprecated>" ++ d ++ "</deprecated>" deprecatedToXML (Just d) = "<deprecated>" ++ d ++ "</deprecated>"
commentToXML Nothing = ""
commentToXML (Just c) = "<comments>" ++ c ++ "</comments>"
sscriptToXML Nothing = "" sscriptToXML Nothing = ""
sscriptToXML (Just s) = "<suppress-script>" ++ s ++ "</suppress-script>" sscriptToXML (Just s) = "<suppress-script>" ++ s ++ "</suppress-script>"
prefToXML Nothing = "" prefToXML Nothing = ""
@ -132,6 +138,7 @@ toXML (Lang l) = "<language><subtag>" ++ (lang'subtag l) ++ "</subtag>" ++
descrToXML (lang'descr l) ++ descrToXML (lang'descr l) ++
(sscriptToXML (lang'script l)) ++ (sscriptToXML (lang'script l)) ++
deprecatedToXML (lang'deprecated l) ++ deprecatedToXML (lang'deprecated l) ++
commentToXML (lang'comment l) ++
prefToXML (lang'preferredValue l) ++ prefToXML (lang'preferredValue l) ++
macrolToXML (lang'macroLanguage l) ++ macrolToXML (lang'macroLanguage l) ++
scopeToXML (lang'scope 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>" ++ toXML (GF t) = "<grandfathered><tag>" ++ (gf'tag t) ++ "</tag>" ++
addedToXML (gf'added t) ++ addedToXML (gf'added t) ++
descrToXML (gf'descr t) ++ "</grandfathered>\n" 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) ++ addedToXML (script'added s) ++
descrToXML (script'descr s) ++ "</script>\n" 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) ++ addedToXML (region'added r) ++
descrToXML (region'descr r) ++ "</region>\n" descrToXML (region'descr r) ++ "</region>\n"
toXML (Var v) = "<variant><subtag>" ++ (variant'subtag v) ++ "</subtag>" ++ toXML (Var v) = "<variant><subtag>" ++ (variant'subtag v) ++ "</subtag>" ++
commentToXML (variant'comment v) ++
addedToXML (variant'added v) ++ addedToXML (variant'added v) ++
descrToXML (variant'descr v) ++ descrToXML (variant'descr v) ++
prefixesToXML (variant'prefix v) ++ "</variant>\n" prefixesToXML (variant'prefix v) ++ "</variant>\n"

16
Registry/Utils/PostgreSQL.hs
View File

@ -10,7 +10,7 @@ escape = concatMap fixChar
fixChar c = [c] fixChar c = [c]
maybeToPostgreSQL Nothing = "NULL" maybeToPostgreSQL Nothing = "NULL"
maybeToPostgreSQL (Just s) = "'" ++ s ++ "'" maybeToPostgreSQL (Just s) = "'" ++ (escape s) ++ "'"
onedescrToPostgreSQL "language" i s = "INSERT INTO Descriptions (description) " ++ onedescrToPostgreSQL "language" i s = "INSERT INTO Descriptions (description) " ++
" VALUES ('" ++ (escape s) ++ "');\n" ++ " 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) descrToPostgreSQL recordtype a i = concat (map (onedescrToPostgreSQL recordtype i) a)
toPostgreSQL (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++ toPostgreSQL (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++
"preferredvalue, added) " ++ "preferredvalue, comments, added) " ++
"VALUES (" ++ "VALUES (" ++
"'" ++ (lang'subtag l) ++ "', " ++ "'" ++ (lang'subtag l) ++ "', " ++
(maybeToPostgreSQL (lang'script l)) ++ ", " ++ (maybeToPostgreSQL (lang'script l)) ++ ", " ++
(maybeToPostgreSQL (lang'preferredValue l)) ++ ", " ++ (maybeToPostgreSQL (lang'preferredValue l)) ++ ", " ++
(maybeToPostgreSQL (lang'comment l)) ++ ", " ++
"'" ++ (lang'added l) ++ "');\n" ++ "'" ++ (lang'added l) ++ "');\n" ++
(descrToPostgreSQL "language" (lang'descr l) (lang'subtag l)) (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 (" ++ "VALUES (" ++
"'" ++ (script'subtag s) ++ "', " ++ "'" ++ (script'subtag s) ++ "', " ++
(maybeToPostgreSQL (script'comment s)) ++ ", " ++
"'" ++ (script'added s) ++ "');\n" ++ "'" ++ (script'added s) ++ "');\n" ++
(descrToPostgreSQL "script" (script'descr s) (script'subtag s)) (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 (" ++ "VALUES (" ++
"'" ++ (region'subtag r) ++ "', " ++ "'" ++ (region'subtag r) ++ "', " ++
(maybeToPostgreSQL (region'comment r)) ++ ", " ++
"'" ++ (region'added r) ++ "');\n" ++ "'" ++ (region'added r) ++ "');\n" ++
(descrToPostgreSQL "region" (region'descr r) (region'subtag r)) (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 (" ++ "VALUES (" ++
"'" ++ (variant'subtag v) ++ "', " ++ "'" ++ (variant'subtag v) ++ "', " ++
(maybeToPostgreSQL (variant'comment v)) ++ ", " ++
"'" ++ (variant'added v) ++ "');\n" ++ "'" ++ (variant'added v) ++ "');\n" ++
(descrToPostgreSQL "variant" (variant'descr v) (variant'subtag v)) (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] fixChar c = [c]
maybeToSQLite Nothing = "NULL" maybeToSQLite Nothing = "NULL"
maybeToSQLite (Just s) = "'" ++ s ++ "'" maybeToSQLite (Just s) = "'" ++ (escape s) ++ "'"
-- TODO: use "SELECT last_insert_rowid();" is probably cleaner than -- TODO: use "SELECT last_insert_rowid();" is probably cleaner than
-- "SELECT max(oid)" -- "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) descrToSQLite recordtype a i = concat (map (onedescrToSQLite recordtype i) a)
toSQLite (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++ toSQLite (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++
"preferredvalue, added) " ++ "preferredvalue, comments, added) " ++
"VALUES (" ++ "VALUES (" ++
"'" ++ (lang'subtag l) ++ "', " ++ "'" ++ (lang'subtag l) ++ "', " ++
(maybeToSQLite (lang'script l)) ++ ", " ++ (maybeToSQLite (lang'script l)) ++ ", " ++
(maybeToSQLite (lang'preferredValue l)) ++ ", " ++ (maybeToSQLite (lang'preferredValue l)) ++ ", " ++
(maybeToSQLite (lang'comment l)) ++ ", " ++
"'" ++ (lang'added l) ++ "');\n" ++ "'" ++ (lang'added l) ++ "');\n" ++
(descrToSQLite "language" (lang'descr l) (lang'subtag l)) (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 (" ++ "VALUES (" ++
"'" ++ (script'subtag s) ++ "', " ++ "'" ++ (script'subtag s) ++ "', " ++
(maybeToSQLite (script'comment s)) ++ ", " ++
"'" ++ (script'added s) ++ "');\n" ++ "'" ++ (script'added s) ++ "');\n" ++
(descrToSQLite "script" (script'descr s) (script'subtag s)) (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 (" ++ "VALUES (" ++
"'" ++ (region'subtag r) ++ "', " ++ "'" ++ (region'subtag r) ++ "', " ++
(maybeToSQLite (region'comment r)) ++ ", " ++
"'" ++ (region'added r) ++ "');\n" ++ "'" ++ (region'added r) ++ "');\n" ++
(descrToSQLite "region" (region'descr r) (region'subtag r)) (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 (" ++ "VALUES (" ++
"'" ++ (variant'subtag v) ++ "', " ++ "'" ++ (variant'subtag v) ++ "', " ++
(maybeToSQLite (variant'comment v)) ++ ", " ++
"'" ++ (variant'added v) ++ "');\n" ++ "'" ++ (variant'added v) ++ "');\n" ++
(descrToSQLite "variant" (variant'descr v) (variant'subtag v)) (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 preferredvalue TEXT, -- Yes, it should REFERENCES Languages(code), but
-- there is a chicken-and-egg problem. -- there is a chicken-and-egg problem.
added DATE, added DATE,
deprecated DATE,
comments TEXT); comments TEXT);
CREATE TABLE Extlangs ( CREATE TABLE Extlangs (