From 1e2ca40440c364574689cceab9b3f5ed7bcff299 Mon Sep 17 00:00:00 2001 From: Stephane Bortzmeyer Date: Fri, 9 Jun 2023 09:05:48 +0200 Subject: [PATCH] Two forgotten files --- Registry/Utils/PostgreSQL.hs | 59 ++++++++++++++++++++++++++++++++++ Registry/Utils/SQLite.hs | 61 ++++++++++++++++++++++++++++++++++++ 2 files changed, 120 insertions(+) create mode 100644 Registry/Utils/PostgreSQL.hs create mode 100644 Registry/Utils/SQLite.hs diff --git a/Registry/Utils/PostgreSQL.hs b/Registry/Utils/PostgreSQL.hs new file mode 100644 index 0000000..0ecf58e --- /dev/null +++ b/Registry/Utils/PostgreSQL.hs @@ -0,0 +1,59 @@ +module Registry.Utils.PostgreSQL where + +import Registry.Grammar +import Registry.Types + +escape :: String -> String +escape = concatMap fixChar + where + fixChar '\'' = "\'\'" + fixChar c = [c] + +maybeToPostgreSQL Nothing = "NULL" +maybeToPostgreSQL (Just s) = "'" ++ s ++ "'" + +onedescrToPostgreSQL "language" i s = "INSERT INTO Descriptions (description) " ++ + " VALUES ('" ++ (escape s) ++ "');\n" ++ + "INSERT INTO Descriptions_languages (description, lang) " ++ + " SELECT currval('Descriptions_id_seq'), '" ++ i ++ "';\n" +onedescrToPostgreSQL "script" i s = "INSERT INTO Descriptions (description) " ++ + " VALUES ('" ++ (escape s) ++ "');\n" ++ + "INSERT INTO Descriptions_scripts (description, script) " ++ + " SELECT currval('Descriptions_id_seq'), '" ++ i ++ "';\n" +onedescrToPostgreSQL "region" i s = "INSERT INTO Descriptions (description) " ++ + " VALUES ('" ++ (escape s) ++ "');\n" ++ + "INSERT INTO Descriptions_regions (description, region) " ++ + " SELECT currval('Descriptions_id_seq'), '" ++ i ++ "';\n" +onedescrToPostgreSQL "variant" i s = "INSERT INTO Descriptions (description) " ++ + " VALUES ('" ++ (escape s) ++ "');\n" ++ + "INSERT INTO Descriptions_variants (description, variant) " ++ + " SELECT currval('Descriptions_id_seq'), '" ++ i ++ "';\n" +descrToPostgreSQL recordtype a i = concat (map (onedescrToPostgreSQL recordtype i) a) + +toPostgreSQL (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++ + "preferredvalue, added) " ++ + "VALUES (" ++ + "'" ++ (lang'subtag l) ++ "', " ++ + (maybeToPostgreSQL (lang'script l)) ++ ", " ++ + (maybeToPostgreSQL (lang'preferredValue l)) ++ ", " ++ + "'" ++ (lang'added l) ++ "');\n" ++ + (descrToPostgreSQL "language" (lang'descr l) (lang'subtag l)) + +toPostgreSQL (Scr s) = "INSERT INTO Scripts (code, added) " ++ + "VALUES (" ++ + "'" ++ (script'subtag s) ++ "', " ++ + "'" ++ (script'added s) ++ "');\n" ++ + (descrToPostgreSQL "script" (script'descr s) (script'subtag s)) + +toPostgreSQL (Reg r) = "INSERT INTO Regions (code, added) " ++ + "VALUES (" ++ + "'" ++ (region'subtag r) ++ "', " ++ + "'" ++ (region'added r) ++ "');\n" ++ + (descrToPostgreSQL "region" (region'descr r) (region'subtag r)) + +toPostgreSQL (Var v) = "INSERT INTO Variants (code, added) " ++ + "VALUES (" ++ + "'" ++ (variant'subtag 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 new file mode 100644 index 0000000..4b8ed03 --- /dev/null +++ b/Registry/Utils/SQLite.hs @@ -0,0 +1,61 @@ +module Registry.Utils.SQLite where + +import Registry.Grammar +import Registry.Types + +escape :: String -> String +escape = concatMap fixChar + where + fixChar '\'' = "''" + fixChar c = [c] + +maybeToSQLite Nothing = "NULL" +maybeToSQLite (Just s) = "'" ++ s ++ "'" + +-- TODO: use "SELECT last_insert_rowid();" is probably cleaner than +-- "SELECT max(oid)" +onedescrToSQLite "language" i s = "INSERT INTO Descriptions (description) " ++ + " VALUES ('" ++ (escape s) ++ "');\n" ++ + "INSERT INTO Descriptions_languages (description, lang) " ++ + " SELECT max(oid), '" ++ i ++ "' FROM Descriptions;\n" +onedescrToSQLite "script" i s = "INSERT INTO Descriptions (description) " ++ + " VALUES ('" ++ (escape s) ++ "');\n" ++ + "INSERT INTO Descriptions_scripts (description, script) " ++ + " SELECT max(oid), '" ++ i ++ "' FROM Descriptions;\n" +onedescrToSQLite "region" i s = "INSERT INTO Descriptions (description) " ++ + " VALUES ('" ++ (escape s) ++ "');\n" ++ + "INSERT INTO Descriptions_regions (description, region) " ++ + " SELECT max(oid), '" ++ i ++ "' FROM Descriptions;\n" +onedescrToSQLite "variant" i s = "INSERT INTO Descriptions (description) " ++ + " VALUES ('" ++ (escape s) ++ "');\n" ++ + "INSERT INTO Descriptions_variants (description, variant) " ++ + " SELECT max(oid), '" ++ i ++ "' FROM Descriptions;\n" +descrToSQLite recordtype a i = concat (map (onedescrToSQLite recordtype i) a) + +toSQLite (Lang l) = "INSERT INTO Languages (code, suppressscript, " ++ + "preferredvalue, added) " ++ + "VALUES (" ++ + "'" ++ (lang'subtag l) ++ "', " ++ + (maybeToSQLite (lang'script l)) ++ ", " ++ + (maybeToSQLite (lang'preferredValue l)) ++ ", " ++ + "'" ++ (lang'added l) ++ "');\n" ++ + (descrToSQLite "language" (lang'descr l) (lang'subtag l)) + +toSQLite (Scr s) = "INSERT INTO Scripts (code, added) " ++ + "VALUES (" ++ + "'" ++ (script'subtag s) ++ "', " ++ + "'" ++ (script'added s) ++ "');\n" ++ + (descrToSQLite "script" (script'descr s) (script'subtag s)) + +toSQLite (Reg r) = "INSERT INTO Regions (code, added) " ++ + "VALUES (" ++ + "'" ++ (region'subtag r) ++ "', " ++ + "'" ++ (region'added r) ++ "');\n" ++ + (descrToSQLite "region" (region'descr r) (region'subtag r)) + +toSQLite (Var v) = "INSERT INTO Variants (code, added) " ++ + "VALUES (" ++ + "'" ++ (variant'subtag v) ++ "', " ++ + "'" ++ (variant'added v) ++ "');\n" ++ + (descrToSQLite "variant" (variant'descr v) (variant'subtag v)) +