GaBuZoMeu/Registry/Utils/PostgreSQL.hs
2023-09-30 17:31:16 +02:00

68 lines
3.8 KiB
Haskell

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) = "'" ++ (escape 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, 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, 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, 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, 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))