GaBuZoMeu/Registry/Utils/SQLite.hs

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) = "'" ++ (escape s) ++ "'"
maybeListToSQLite Nothing = "NULL"
maybeListToSQLite (Just s) = "'" ++ (foldr (++) "" (map escape 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, deprecated, comments, added) " ++
                          "VALUES (" ++
                            "'" ++ (lang'subtag l) ++ "', " ++
                            (maybeToSQLite (lang'script l)) ++ ", " ++
                            (maybeToSQLite (lang'preferredValue l)) ++ ", " ++
                            (maybeToSQLite (lang'deprecated l)) ++ ", " ++ 
                            (maybeListToSQLite (lang'comment l)) ++ ", " ++ 
                            "'" ++ (lang'added l) ++ "');\n" ++
                         (descrToSQLite "language" (lang'descr l) (lang'subtag l))

toSQLite (Scr s) = "INSERT INTO Scripts (code, deprecated, comments, added) " ++
                          "VALUES (" ++
                            "'" ++ (script'subtag s) ++ "', " ++
                            (maybeToSQLite (script'deprecated s)) ++ ", " ++ 
                            (maybeListToSQLite (script'comment s)) ++ ", " ++ 
                            "'" ++ (script'added s) ++ "');\n" ++
                        (descrToSQLite "script" (script'descr s) (script'subtag s))

toSQLite (Reg r) = "INSERT INTO Regions (code, deprecated, comments, added) " ++
                          "VALUES (" ++
                            "'" ++ (region'subtag r) ++ "', " ++
                            (maybeToSQLite (region'deprecated r)) ++ ", " ++ 
                            (maybeListToSQLite (region'comment r)) ++ ", " ++ 
                            "'" ++ (region'added r) ++ "');\n" ++
                        (descrToSQLite "region" (region'descr r) (region'subtag r))

toSQLite (Var v) = "INSERT INTO Variants (code, deprecated, comments, added) " ++
                          "VALUES (" ++
                            "'" ++ (variant'subtag v) ++ "', " ++
                            (maybeToSQLite (variant'deprecated v)) ++ ", " ++ 
                            (maybeListToSQLite (variant'comment v)) ++ ", " ++ 
                            "'" ++ (variant'added v) ++ "');\n" ++
                        (descrToSQLite "variant" (variant'descr v) (variant'subtag v))