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

Keep deprecation in most conversions

Browse Source
This commit is contained in:
Stephane Bortzmeyer 2023-09-30 17:31:16 +02:00
parent 6284bdc2c7
commit 770b7a1e14
8 changed files with 40 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Makefile
View File

@ -33,6 +33,11 @@ ${REGISTRYFILE}: check-registry
./check-registry ${REGISTRYFILE} ./check-registry ${REGISTRYFILE}
touch ${REGISTRYFILE} touch ${REGISTRYFILE}
convert: ${REGISTRYFILE} ${ALL_PROGRAMS}
./registry2mulhtml
./registry2postgresql > lsr-postgresql.sql
./registry2sqlite > lsr-sqlite.sql
dist: clean dist: clean
(cd ..; tar cvf ${TARBALL} --exclude hnop --exclude ltr*.txt GaBuZoMeu && gzip --best --force --verbose ${TARBALL}) (cd ..; tar cvf ${TARBALL} --exclude hnop --exclude ltr*.txt GaBuZoMeu && gzip --best --force --verbose ${TARBALL})

3
Registry/Grammar.hs
View File

@ -83,17 +83,20 @@ recordFactory r =
(fromJust (lookup "Subtag" r)) (fromJust (lookup "Subtag" r))
(lookups "Description" r) (lookups "Description" r)
(fromJust (lookup "Added" r)) (fromJust (lookup "Added" r))
(lookup "Deprecated" r)
(lookup "Comments" r))) (lookup "Comments" r)))
"region" -> Right (Reg (Region "region" -> Right (Reg (Region
(fromJust (lookup "Subtag" r)) (fromJust (lookup "Subtag" r))
(lookups "Description" r) (lookups "Description" r)
(fromJust (lookup "Added" r)) (fromJust (lookup "Added" r))
(lookup "Deprecated" r)
(lookup "Comments" r))) (lookup "Comments" r)))
"variant" -> Right (Var (Variant "variant" -> Right (Var (Variant
(fromJust (lookup "Subtag" r)) (fromJust (lookup "Subtag" r))
(lookups "Description" r) (lookups "Description" r)
(fromJust (lookup "Added" r)) (fromJust (lookup "Added" r))
(lookups "Prefix" r) (lookups "Prefix" r)
(lookup "Deprecated" r)
(lookup "Comments" r))) (lookup "Comments" r)))
"redundant" -> Right (Red (Redundant "redundant" -> Right (Red (Redundant
(fromJust (lookup "Tag" r)) (fromJust (lookup "Tag" r))

7
Registry/Types.hs
View File

@ -22,14 +22,15 @@ data Extlang = Extlang {extlang'subtag::String, extlang'descr::[String],
deriving Show deriving Show
data Script = Script {script'subtag::String, script'descr::[String], data Script = Script {script'subtag::String, script'descr::[String],
script'added::DateTime, script'comment::Maybe String} deriving Show script'added::DateTime, script'deprecated::Maybe DateTime, script'comment::Maybe String} deriving Show
data Region = Region {region'subtag::String, region'descr::[String], data Region = Region {region'subtag::String, region'descr::[String],
region'added::DateTime, region'comment::Maybe String} deriving Show region'added::DateTime, region'deprecated::Maybe DateTime, region'comment::Maybe String} deriving Show
-- TODO: Deprecated and preferredValue -- TODO: PreferredValue
data Variant = Variant {variant'subtag::String, variant'descr::[String], data Variant = Variant {variant'subtag::String, variant'descr::[String],
variant'added::DateTime, variant'prefix::[String], variant'added::DateTime, variant'prefix::[String],
variant'deprecated::Maybe DateTime,
variant'comment::Maybe String} deriving Show variant'comment::Maybe String} deriving Show
data Redundant = Redundant {redundant'tag::String, redundant'descr::[String], data Redundant = Redundant {redundant'tag::String, redundant'descr::[String],

6
Registry/Utils.hs
View File

@ -196,6 +196,8 @@ oneprefixToHTML s = " Possible prefix: <code><a href=\"../language/" ++ s ++ ".h
prefixesToHTML a = concat (map oneprefixToHTML a) prefixesToHTML a = concat (map oneprefixToHTML a)
commentToHTML Nothing = "" commentToHTML Nothing = ""
commentToHTML (Just s) = " Comment: " ++ s commentToHTML (Just s) = " Comment: " ++ s
deprecatedToHTML Nothing = ""
deprecatedToHTML (Just s) = " Deprecated: " ++ s
toHTML (Date d) = "<p>Date: " ++ dateToHTML d ++ "</p>" toHTML (Date d) = "<p>Date: " ++ dateToHTML d ++ "</p>"
toHTML (Lang l) = (html_head ((lang'descr l) !! 0)) ++ "<p>Code <code>" ++ toHTML (Lang l) = (html_head ((lang'descr l) !! 0)) ++ "<p>Code <code>" ++
@ -204,6 +206,7 @@ toHTML (Lang l) = (html_head ((lang'descr l) !! 0)) ++ "<p>Code <code>" ++
descrToHTML (lang'descr l) ++ ". " ++ descrToHTML (lang'descr l) ++ ". " ++
linkLanguage (lang'subtag l) ++ linkLanguage (lang'subtag l) ++
(sscriptToHTML (lang'script l)) ++ (sscriptToHTML (lang'script l)) ++
deprecatedToHTML (lang'deprecated l) ++
commentToHTML (lang'comment l) ++ "</p>" ++ html_tail ++ "\n" commentToHTML (lang'comment l) ++ "</p>" ++ html_tail ++ "\n"
toHTML (GF t) = "<p>Code <code>" ++ (gf'tag t) ++ "</code>. " ++ toHTML (GF t) = "<p>Code <code>" ++ (gf'tag t) ++ "</code>. " ++
addedToHTML (gf'added t) ++ ". " ++ addedToHTML (gf'added t) ++ ". " ++
@ -212,12 +215,14 @@ toHTML (Scr s) = (html_head ((script'descr s) !! 0)) ++ "<p>Code <code>" ++
(script'subtag s) ++ "</code>. " ++ (script'subtag s) ++ "</code>. " ++
addedToHTML (script'added s) ++ ". Description: " ++ addedToHTML (script'added s) ++ ". Description: " ++
descrToHTML (script'descr s) ++ descrToHTML (script'descr s) ++
deprecatedToHTML (script'deprecated s) ++
commentToHTML (script'comment s) ++ "</p>" ++ html_tail ++ "\n" commentToHTML (script'comment s) ++ "</p>" ++ html_tail ++ "\n"
toHTML (Reg r) = (html_head ((region'descr r) !! 0)) ++ "<p>Code <code>" ++ toHTML (Reg r) = (html_head ((region'descr r) !! 0)) ++ "<p>Code <code>" ++
(region'subtag r) ++ "</code>. " ++ (region'subtag r) ++ "</code>. " ++
addedToHTML (region'added r) ++ addedToHTML (region'added r) ++
". Description: " ++ ". Description: " ++
descrToHTML (region'descr r) ++ descrToHTML (region'descr r) ++
deprecatedToHTML (region'deprecated r) ++
commentToHTML (region'comment r) ++ "</p>" ++ commentToHTML (region'comment r) ++ "</p>" ++
html_tail ++ "\n" html_tail ++ "\n"
toHTML (Var v) = (html_head ((variant'descr v) !! 0)) ++ "<p>Code <code>" ++ toHTML (Var v) = (html_head ((variant'descr v) !! 0)) ++ "<p>Code <code>" ++
@ -225,6 +230,7 @@ toHTML (Var v) = (html_head ((variant'descr v) !! 0)) ++ "<p>Code <code>" ++
addedToHTML (variant'added v) ++ ". Description: " ++ addedToHTML (variant'added v) ++ ". Description: " ++
descrToHTML (variant'descr v) ++ ". " ++ descrToHTML (variant'descr v) ++ ". " ++
prefixesToHTML (variant'prefix v) ++ prefixesToHTML (variant'prefix v) ++
deprecatedToHTML (variant'deprecated v) ++
commentToHTML (variant'comment v) ++ "</p>" ++ html_tail ++ "\n" commentToHTML (variant'comment v) ++ "</p>" ++ html_tail ++ "\n"
toHTML (Red r) = (html_head ((redundant'descr r) !! 0)) ++ toHTML (Red r) = (html_head ((redundant'descr r) !! 0)) ++
"<p>Code <code>" ++ (redundant'tag r) ++ "</code>. " ++ "<p>Code <code>" ++ (redundant'tag r) ++ "</code>. " ++

12
Registry/Utils/PostgreSQL.hs
View File

@ -31,32 +31,36 @@ 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, comments, added) " ++ "preferredvalue, deprecated, 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'deprecated l)) ++ ", " ++
(maybeToPostgreSQL (lang'comment 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, comments, added) " ++ toPostgreSQL (Scr s) = "INSERT INTO Scripts (code, deprecated, comments, added) " ++
"VALUES (" ++ "VALUES (" ++
"'" ++ (script'subtag s) ++ "', " ++ "'" ++ (script'subtag s) ++ "', " ++
(maybeToPostgreSQL (script'deprecated s)) ++ ", " ++
(maybeToPostgreSQL (script'comment 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, comments, added) " ++ toPostgreSQL (Reg r) = "INSERT INTO Regions (code, deprecated, comments, added) " ++
"VALUES (" ++ "VALUES (" ++
"'" ++ (region'subtag r) ++ "', " ++ "'" ++ (region'subtag r) ++ "', " ++
(maybeToPostgreSQL (region'deprecated r)) ++ ", " ++
(maybeToPostgreSQL (region'comment 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, comments, added) " ++ toPostgreSQL (Var v) = "INSERT INTO Variants (code, deprecated, comments, added) " ++
"VALUES (" ++ "VALUES (" ++
"'" ++ (variant'subtag v) ++ "', " ++ "'" ++ (variant'subtag v) ++ "', " ++
(maybeToPostgreSQL (variant'deprecated v)) ++ ", " ++
(maybeToPostgreSQL (variant'comment 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))

12
Registry/Utils/SQLite.hs
View File

@ -33,32 +33,36 @@ 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, comments, added) " ++ "preferredvalue, deprecated, 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'deprecated l)) ++ ", " ++
(maybeToSQLite (lang'comment 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, comments, added) " ++ toSQLite (Scr s) = "INSERT INTO Scripts (code, deprecated, comments, added) " ++
"VALUES (" ++ "VALUES (" ++
"'" ++ (script'subtag s) ++ "', " ++ "'" ++ (script'subtag s) ++ "', " ++
(maybeToSQLite (script'deprecated s)) ++ ", " ++
(maybeToSQLite (script'comment 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, comments, added) " ++ toSQLite (Reg r) = "INSERT INTO Regions (code, deprecated, comments, added) " ++
"VALUES (" ++ "VALUES (" ++
"'" ++ (region'subtag r) ++ "', " ++ "'" ++ (region'subtag r) ++ "', " ++
(maybeToSQLite (region'deprecated r)) ++ ", " ++
(maybeToSQLite (region'comment 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, comments, added) " ++ toSQLite (Var v) = "INSERT INTO Variants (code, deprecated, comments, added) " ++
"VALUES (" ++ "VALUES (" ++
"'" ++ (variant'subtag v) ++ "', " ++ "'" ++ (variant'subtag v) ++ "', " ++
(maybeToSQLite (variant'deprecated v)) ++ ", " ++
(maybeToSQLite (variant'comment 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))

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

@ -29,6 +29,7 @@ CREATE TABLE Scripts (
id SERIAL PRIMARY KEY NOT NULL, id SERIAL PRIMARY KEY NOT NULL,
code TEXT UNIQUE NOT NULL, -- TODO: a length and content constraint? code TEXT UNIQUE NOT NULL, -- TODO: a length and content constraint?
added DATE, added DATE,
deprecated DATE,
comments TEXT); comments TEXT);
CREATE TABLE Languages ( CREATE TABLE Languages (
@ -60,6 +61,7 @@ CREATE TABLE Variants (
code TEXT UNIQUE NOT NULL, -- TODO: a length and content constraint? code TEXT UNIQUE NOT NULL, -- TODO: a length and content constraint?
-- TODO: prefixes -- TODO: prefixes
added DATE, added DATE,
deprecated DATE,
comments TEXT); comments TEXT);
CREATE TABLE Extensions ( CREATE TABLE Extensions (

3
SQL/SQLite/create-db-subtag.sql
View File

@ -27,6 +27,7 @@ CREATE TABLE Scripts (
id INTEGER PRIMARY KEY NOT NULL, id INTEGER PRIMARY KEY NOT NULL,
code TEXT UNIQUE NOT NULL, code TEXT UNIQUE NOT NULL,
added DATE, added DATE,
deprecated DATE,
comments TEXT); comments TEXT);
CREATE TABLE Languages ( CREATE TABLE Languages (
@ -36,6 +37,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 (
@ -56,6 +58,7 @@ CREATE TABLE Variants (
id INTEGER PRIMARY KEY NOT NULL, id INTEGER PRIMARY KEY NOT NULL,
code TEXT UNIQUE NOT NULL, code TEXT UNIQUE NOT NULL,
added DATE, added DATE,
deprecated DATE,
comments TEXT); comments TEXT);
CREATE TABLE Descriptions ( CREATE TABLE Descriptions (