MySQL backend
diff --git a/Framework/Http/Middlewares.hs b/Framework/Http/Middlewares.hs
index 15ae309..b30e31f 100644
--- a/Framework/Http/Middlewares.hs
+++ b/Framework/Http/Middlewares.hs
@@ -23,10 +23,13 @@ import qualified Settings (requestMiddlewares, responseMiddlewares)
type RequestMiddleware = StaticConfig -> HttpRequest -> IO HttpRequest
type ResponseMiddleware = StaticConfig -> HttpResponse -> IO HttpResponse
-addEncoding enc _ resp = return $
+addEncoding _ resp = return $
case lookupHeader HdrContentType (rspHeaders resp) of
- Nothing -> replaceHeader HdrContentType ("text/html; charset="++enc) resp
- Just ctype -> insertHeader HdrContentType (ctype++"; charset="++enc) resp
+ Nothing -> replaceHeader HdrContentType ("text/html; charset="++enc) resp
+ Just ctype -> insertHeader HdrContentType (ctype++"; charset="++enc) resp
+ where enc = case lookupHeader (HdrCustom "X-UserCharset") (rspHeaders resp) of
+ Just x -> tail x
+ Nothing -> "UTF-8"
readLanguage ps rq = do
let h = insertHeader (HdrCustom "X-UserLanguage") lang rq
@@ -40,8 +43,8 @@ readLanguage ps rq = do
initI18N ps rq = do
gettextInit (lang++enc) domain dir
return rq
- where lang = fromMaybe "" $ lookupHeader (HdrCustom "X-UserLanguage") hdrs
- enc = fromMaybe "" $ lookupHeader (HdrCustom "X-UserCharset") hdrs
+ where lang = fromMaybe "en_GB" $ lookupHeader (HdrCustom "X-UserLanguage") hdrs
+ enc = fromMaybe ".UTF-8" $ lookupHeader (HdrCustom "X-UserCharset") hdrs
hdrs = rqHeaders rq
domain = getConfigValue cp "gettext" "domain" ""
dir = getConfigValue cp "gettext" "path" "."
@@ -69,7 +72,7 @@ defaultRqMiddlewares :: [RequestMiddleware]
defaultRqMiddlewares = [readLanguage, initI18N]
defaultRspMiddlewares :: [ResponseMiddleware]
-defaultRspMiddlewares = [addEncoding "UTF-8"]
+defaultRspMiddlewares = [addEncoding]
f `o` g = \x -> f x >>= g
diff --git a/Framework/Storage.hs b/Framework/Storage.hs
index 2efe6ae..597fbcc 100644
--- a/Framework/Storage.hs
+++ b/Framework/Storage.hs
@@ -10,8 +10,9 @@ module Framework.Storage
where
+import Data.String.Utils
import qualified Database.HDBC.Sqlite3 as Sqlite3
--- import qualified Database.HDBC.MySQL as MySQL
+import qualified Database.HDBC.MySQL as MySQL
import qualified Database.HDBC.PostgreSQL as PostgreSQL
import qualified Database.HDBC as D
@@ -25,6 +26,16 @@ connect' :: String -- ^ DB backend
-> IO DBConnection
connect' "sqlite3" file = DBC `fmap` (Sqlite3.connectSqlite3 file)
connect' "psql" str = DBC `fmap` (PostgreSQL.connectPostgreSQL str)
+connect' "mysql" str = DBC `fmap` (MySQL.connectMySQL $ parsedMySQL)
+ where
+ parsedMySQL = MySQL.defaultMySQLConnectInfo {
+ MySQL.mysqlUser = user,
+ MySQL.mysqlPassword = pass,
+ MySQL.mysqlHost = server,
+ MySQL.mysqlDatabase = db}
+ [user,x] = split ":" str
+ [pass,x'] = split "@" x
+ [server,db] = split "/" x'
-- | Connect to DB, get parameters from "StaticConfig"
connect :: MPool DBConnection -- ^ Pool of connections
diff --git a/TODO b/TODO
index 609f739..4182cc7 100644
--- a/TODO
+++ b/TODO
@@ -2,7 +2,6 @@ TODO
* Человеческая обработка завершения программы;
* Соответственно, все параметры, которые сейчас hard-coded, брать из конфига;
- * Бэкенд для MySQL;
* Более высокоуровневый интерфейс для кэша - чтоб было легко закэшировать результат всей функции;
* Соответственно, простые средства для инвалидации кэша;
* Более продвинутые и высокоуровневые функции генерации SQL;
@@ -13,6 +12,7 @@ TODO
* (!) Документация ко всей этой красоте.
* Протестировать поддержку PUT web-сервером;
+ * [DONE] Бэкенд для MySQL;
* [DONE] Чтение конфига из файла либо удобный EDSL для конфига;
* [DONE] Перенести текущий правленный Network.Shed.Httpd в дерево проекта (написать свой?);
* [DONE] Лучше интегрировать Httpd в движок, в частности - чтоб средствами движка писал логи итп;
diff --git a/graph.dot b/graph.dot
index 74dec88..1576083 100644
--- a/graph.dot
+++ b/graph.dot
@@ -1,86 +1,81 @@
digraph G {
-u43[label="TemplateParser"];
-u42[label="Plugins"];
-u40[label="Models"];
-u0[label="Main"];
+u49[label="TemplateParser"];
+u48[label="Settings"];
+u45[label="Models"];
+u0[label="Main",color=green];
+
subgraph cluster_0 {
label="Framework";
-color="#ccffcc";
-style="filled";
-u41[label="Markdown"];
-u39[label="Pager"];
-u38[label="ContextProcessors"];
-u27[label="SQL"];
-u20[label="Wrapper"];
-u19[label="Urls"];
-u18[label="Models"];
-u17[label="Storage"];
-u14[label="Cache",shape=box];
-u13[label="Config"];
-u10[label="Logger"];
-u6[label="Controller"];
-u5[label="Pool"];
-u1[label="API", shape=box];
-forms[label="Forms", shape=box];
-http[label="HTTP", shape=box];
-tengine[label="TEngine",shape=box];
+
+api[label="API",shape=box];
+forms[label=Forms,shape=box];
+tengine[label=TEngine,shape=box];
+u47[label="Markdown"];
+u44[label="Pager"];
+u43[label="ContextProcessors"];
+
+subgraph cluster_1 {
+color=gray;
+label=DB;
+orm[label="ORM",shape=box];
+u19[label="Storage"];
+}
+
+cache[label="Cache",shape=box];
+u15[label="Config"];
+u12[label="GetText"];
+
+subgraph cluster_3 {
+color=gray;
+label=Network;
+http[label=HTTP,shape=box,color=red];
+u25[label="Wrapper"];
+u24[label="Urls"];
}
+}
+api -> cache;
+api -> forms;
+api -> http;
+api -> orm;
+api -> tengine;
+api -> u12;
+api -> u19;
+api -> u24;
+api -> u44;
+forms -> api;
forms -> http;
-forms -> u1;
-forms -> u18;
-forms -> u42;
-forms -> u6;
-http -> u10;
-http -> u13;
-http -> u14;
-http -> u17;
+forms -> orm;
+forms -> u48;
+http -> cache;
+http -> u12;
+http -> u15;
http -> u19;
-http -> u5;
-http -> u6;
+http -> u24;
+http -> u48;
+tengine -> api;
+tengine -> cache;
tengine -> http;
-tengine -> u1;
-tengine -> u14;
-tengine -> u38;
-tengine -> u40;
-tengine -> u6;
-u0 -> u1;
-u0 -> u40;
-u14 -> u5;
-u17 -> u18;
-u17 -> u5;
-u19 -> http;
-u19 -> u10;
-u19 -> u20;
-u19 -> u6;
-u1 -> forms;
-u1 -> http;
-u1 -> tengine;
-u1 -> u10;
-u1 -> u14;
-u1 -> u17;
-u1 -> u18;
-u1 -> u19;
-u1 -> u27;
-u1 -> u39;
-u1 -> u6;
-u20 -> http;
-u20 -> u14;
-u20 -> u17;
-u27 -> u18;
-u38 -> u1;
-u38 -> u6;
-u39 -> forms;
-u39 -> http;
-u39 -> u1;
-u39 -> u18;
-u39 -> u27;
-u39 -> u6;
-u40 -> forms;
-u40 -> u17;
-u40 -> u18;
-u40 -> u41;
-u42 -> forms;
-u6 -> http;
+tengine -> u43;
+tengine -> u45;
+u0 -> api;
+u0 -> u45;
+u19 -> orm;
+u24 -> http;
+u24 -> u25;
+u25 -> cache;
+u25 -> http;
+u25 -> u19;
+u43 -> api;
+u44 -> api;
+u44 -> forms;
+u44 -> http;
+u44 -> orm;
+u45 -> forms;
+u45 -> orm;
+u45 -> u47;
+u48 -> forms;
+u48 -> tengine;
+
}