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}
touch ${REGISTRYFILE}
convert: ${REGISTRYFILE} ${ALL_PROGRAMS}
./registry2mulhtml
./registry2postgresql > lsr-postgresql.sql
./registry2sqlite > lsr-sqlite.sql
dist: clean
(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))
(lookups "Description" r)
(fromJust (lookup "Added" r))
(lookup "Deprecated" r)
(lookup "Comments" r)))
"region" -> Right (Reg (Region
(fromJust (lookup "Subtag" r))
(lookups "Description" r)
(fromJust (lookup "Added" r))
(lookup "Deprecated" r)
(lookup "Comments" r)))
"variant" -> Right (Var (Variant
(fromJust (lookup "Subtag" r))
(lookups "Description" r)
(fromJust (lookup "Added" r))
(lookups "Prefix" r)
(lookup "Deprecated" r)
(lookup "Comments" r)))
"redundant" -> Right (Red (Redundant
(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
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],
region'added::DateTime, region'comment::Maybe String} deriving Show
-- TODO: Deprecated and preferredValue
region'added::DateTime, region'deprecated::Maybe DateTime, region'comment::Maybe String} deriving Show
-- TODO: PreferredValue
data Variant = Variant {variant'subtag::String, variant'descr::[String],
variant'added::DateTime, variant'prefix::[String],
variant'deprecated::Maybe DateTime,
variant'comment::Maybe String} deriving Show
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)
commentToHTML Nothing = ""
commentToHTML (Just s) = " Comment: " ++ s
deprecatedToHTML Nothing = ""
deprecatedToHTML (Just s) = " Deprecated: " ++ s
toHTML (Date d) = "<p>Date: " ++ dateToHTML d ++ "</p>"
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) ++ ". " ++
linkLanguage (lang'subtag l) ++
(sscriptToHTML (lang'script l)) ++
deprecatedToHTML (lang'deprecated l) ++
commentToHTML (lang'comment l) ++ "</p>" ++ html_tail ++ "\n"
toHTML (GF t) = "<p>Code <code>" ++ (gf'tag t) ++ "</code>. " ++
addedToHTML (gf'added t) ++ ". " ++
@ -212,12 +215,14 @@ toHTML (Scr s) = (html_head ((script'descr s) !! 0)) ++ "<p>Code <code>" ++
(script'subtag s) ++ "</code>. " ++
addedToHTML (script'added s) ++ ". Description: " ++
descrToHTML (script'descr s) ++
deprecatedToHTML (script'deprecated s) ++
commentToHTML (script'comment s) ++ "</p>" ++ html_tail ++ "\n"
toHTML (Reg r) = (html_head ((region'descr r) !! 0)) ++ "<p>Code <code>" ++
(region'subtag r) ++ "</code>. " ++
addedToHTML (region'added r) ++
". Description: " ++
descrToHTML (region'descr r) ++
deprecatedToHTML (region'deprecated r) ++
commentToHTML (region'comment r) ++ "</p>" ++
html_tail ++ "\n"
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: " ++
descrToHTML (variant'descr v) ++ ". " ++
prefixesToHTML (variant'prefix v) ++
deprecatedToHTML (variant'deprecated v) ++
commentToHTML (variant'comment v) ++ "</p>" ++ html_tail ++ "\n"
toHTML (Red r) = (html_head ((redundant'descr r) !! 0)) ++
"<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)
toPostgreSQL (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++
"preferredvalue, comments, added) " ++
"preferredvalue, deprecated, comments, added) " ++
"VALUES (" ++
"'" ++ (lang'subtag l) ++ "', " ++
(maybeToPostgreSQL (lang'script l)) ++ ", " ++
(maybeToPostgreSQL (lang'preferredValue l)) ++ ", " ++
(maybeToPostgreSQL (lang'deprecated l)) ++ ", " ++
(maybeToPostgreSQL (lang'comment l)) ++ ", " ++
"'" ++ (lang'added l) ++ "');\n" ++
(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 (" ++
"'" ++ (script'subtag s) ++ "', " ++
(maybeToPostgreSQL (script'deprecated s)) ++ ", " ++
(maybeToPostgreSQL (script'comment s)) ++ ", " ++
"'" ++ (script'added s) ++ "');\n" ++
(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 (" ++
"'" ++ (region'subtag r) ++ "', " ++
(maybeToPostgreSQL (region'deprecated r)) ++ ", " ++
(maybeToPostgreSQL (region'comment r)) ++ ", " ++
"'" ++ (region'added r) ++ "');\n" ++
(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 (" ++
"'" ++ (variant'subtag v) ++ "', " ++
(maybeToPostgreSQL (variant'deprecated v)) ++ ", " ++
(maybeToPostgreSQL (variant'comment v)) ++ ", " ++
"'" ++ (variant'added v) ++ "');\n" ++
(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)
toSQLite (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++
"preferredvalue, comments, added) " ++
"preferredvalue, deprecated, comments, added) " ++
"VALUES (" ++
"'" ++ (lang'subtag l) ++ "', " ++
(maybeToSQLite (lang'script l)) ++ ", " ++
(maybeToSQLite (lang'preferredValue l)) ++ ", " ++
(maybeToSQLite (lang'deprecated l)) ++ ", " ++
(maybeToSQLite (lang'comment l)) ++ ", " ++
"'" ++ (lang'added l) ++ "');\n" ++
(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 (" ++
"'" ++ (script'subtag s) ++ "', " ++
(maybeToSQLite (script'deprecated s)) ++ ", " ++
(maybeToSQLite (script'comment s)) ++ ", " ++
"'" ++ (script'added s) ++ "');\n" ++
(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 (" ++
"'" ++ (region'subtag r) ++ "', " ++
(maybeToSQLite (region'deprecated r)) ++ ", " ++
(maybeToSQLite (region'comment r)) ++ ", " ++
"'" ++ (region'added r) ++ "');\n" ++
(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 (" ++
"'" ++ (variant'subtag v) ++ "', " ++
(maybeToSQLite (variant'deprecated v)) ++ ", " ++
(maybeToSQLite (variant'comment v)) ++ ", " ++
"'" ++ (variant'added v) ++ "');\n" ++
(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,
code TEXT UNIQUE NOT NULL, -- TODO: a length and content constraint?
added DATE,
deprecated DATE,
comments TEXT);
CREATE TABLE Languages (
@ -60,6 +61,7 @@ CREATE TABLE Variants (
code TEXT UNIQUE NOT NULL, -- TODO: a length and content constraint?
-- TODO: prefixes
added DATE,
deprecated DATE,
comments TEXT);
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,
code TEXT UNIQUE NOT NULL,
added DATE,
deprecated DATE,
comments TEXT);
CREATE TABLE Languages (
@ -36,6 +37,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 (
@ -56,6 +58,7 @@ CREATE TABLE Variants (
id INTEGER PRIMARY KEY NOT NULL,
code TEXT UNIQUE NOT NULL,
added DATE,
deprecated DATE,
comments TEXT);
CREATE TABLE Descriptions (