forked from bortzmeyer/GaBuZoMeu
Two forgotten files
This commit is contained in:
parent
2fc541c0a7
commit
1e2ca40440
59
Registry/Utils/PostgreSQL.hs
Normal file
59
Registry/Utils/PostgreSQL.hs
Normal file
@ -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))
|
||||||
|
|
61
Registry/Utils/SQLite.hs
Normal file
61
Registry/Utils/SQLite.hs
Normal file
@ -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))
|
||||||
|
|
Loading…
x
Reference in New Issue
Block a user