Add a module to read config from a file.
Add a module to read config from a file.
diff --git a/Blog/Blog.hs b/Blog/Blog.hs
index 8d3b23c..218a939 100644
--- a/Blog/Blog.hs
+++ b/Blog/Blog.hs
@@ -17,7 +17,6 @@ import Framework.Models
import Framework.Pager
import Framework.Cache
-import Config
import Models
import Plugins
@@ -130,4 +129,4 @@ onepost conf sid = Just $ do
pid = read sid
-main = serveHttp params urlconf
+main = serveHttp "blog.conf" urlconf
diff --git a/Blog/blog.conf b/Blog/blog.conf
new file mode 100644
index 0000000..edb5810
--- /dev/null
+++ b/Blog/blog.conf
@@ -0,0 +1,16 @@
+[network]
+port = 8080
+
+[static]
+staticPath = static/
+
+[database]
+path = host=rtfm-server password=31415
+
+[cache]
+backend = filesystem
+path = tmp
+
+[sessions]
+path = tmp/sessions
+
diff --git a/Framework/Config.hs b/Framework/Config.hs
new file mode 100644
index 0000000..446da47
--- /dev/null
+++ b/Framework/Config.hs
@@ -0,0 +1,45 @@
+module Framework.Config where
+
+import System.IO
+import System.Directory
+import qualified Data.ConfigFile as CF
+import Data.Either
+
+import Framework.Types
+
+getConfigPath :: String -> IO FilePath
+getConfigPath name = do
+ let etc = "/etc/"++name
+ ex <- doesFileExist etc
+ if ex
+ then return etc
+ else do
+ ex' <- doesFileExist name
+ if ex'
+ then return name
+ else error "Could not find config!"
+
+get' :: CF.Get_C a => CF.ConfigParser -> CF.SectionSpec -> CF.OptionSpec -> a -> a
+get' cp s o d = either (const d) id $ CF.get cp s o
+
+readConfig :: String -> StartupConfig -> IO StaticConfig
+readConfig name sc = do
+ path <- getConfigPath name
+ ecp <- CF.readfile CF.emptyCP path
+ case ecp of
+ Right cp -> do
+ return $ HP {
+ portNumber = get' cp "network" "port" 80,
+ docdir = get' cp "static" "staticdir" "static",
+ dbDriver = get' cp "database" "backend" "psql",
+ dbPath = get' cp "database" "path" "",
+ cacheDriver = get' cp "cache" "backend" "fake",
+ cachePath = get' cp "cache" "path" "/var/cache/web",
+ sessionsDriver = get' cp "sessions" "backend" "files",
+ sessionsPath = get' cp "sessions" "path" "/var/sessions",
+ dbpool = dbpoolSC sc,
+ cpool = cpoolSC sc,
+ logChan = logChanSC sc,
+ errChan = errChanSC sc }
+ Left err -> error $ show err
+
diff --git a/Framework/Http/HTTPServer.hs b/Framework/Http/HTTPServer.hs
index 4e6db48..b9b1837 100644
--- a/Framework/Http/HTTPServer.hs
+++ b/Framework/Http/HTTPServer.hs
@@ -17,6 +17,7 @@ import Network.URI
import Network.HTTP
import Data.Maybe
+import Framework.Config
import Framework.Cache
import Framework.Storage
import Framework.Pool
@@ -88,23 +89,24 @@ cleanup dbPool cPool hacc herr = do
exitWith ExitSuccess
-- | Start HTTP server
-serveHttp :: StaticConfig -- ^ Server config
+serveHttp :: String -- ^ Name of the config file
-> URLConf -- ^ URL dispatcher config
-> IO ()
-serveHttp hap conf = do
+serveHttp name urlconf = do
dbPool <- emptyPool 10
cPool <- emptyPool 10
- garbageCollector dbPool disconnect'
- garbageCollector cPool cDisconnect
aLog <- newChan
eLog <- newChan
+ conf <- readConfig name $ StartupConfig dbPool cPool aLog eLog
+ garbageCollector dbPool disconnect'
+ garbageCollector cPool cDisconnect
hAccess <- openFile "access.log" WriteMode
hErrors <- openFile "errors.log" WriteMode
runLogWriter aLog eLog hAccess hErrors
- let hap' = hap {dbpool = dbPool,
- cpool = cPool,
- logChan = aLog,
- errChan = eLog }
+ let conf' = conf {dbpool = dbPool,
+ cpool = cPool,
+ logChan = aLog,
+ errChan = eLog }
installHandler sigINT (CatchOnce (cleanup dbPool cPool hAccess hErrors)) Nothing
- initServer hap' (httpWorker hap' conf)
+ initServer conf' (httpWorker conf' urlconf)
diff --git a/Framework/Types.hs b/Framework/Types.hs
index 15e05a0..ca6b0ef 100644
--- a/Framework/Types.hs
+++ b/Framework/Types.hs
@@ -46,6 +46,14 @@ data StaticConfig = HP {
}
deriving (Show)
+data StartupConfig = StartupConfig {
+ dbpoolSC :: MPool DBConnection, -- ^ DB connections pool
+ cpoolSC :: MPool CacheConnection,-- ^ Cache connections pool
+ logChanSC :: Log, -- ^ Handle to log
+ errChanSC :: Log -- ^ Handle to errors log
+ }
+ deriving (Show)
+
-- | Runtime controller action configuration
data ActionConfig = ActionConfig {
request :: HttpRequest, -- ^ HTTP request
diff --git a/README.ru b/README.ru
index b05874e..91a18a6 100644
--- a/README.ru
+++ b/README.ru
@@ -9,7 +9,7 @@
* URL dispatcher
* Модуль для работы с БД (использует HDBC, в настоящий момент полноценно работает только с PostgreSQL, sqlite3 поддерживает не все запросы)
* EDSL для описания моделей данных (таблиц БД)
- * EDSL для формирования SQL-запросов
+ * EDSL для формирования SQL-запросов по моделям данных
* Templating Engine - шаблоны пишутся в отдельных файлах с синтаксисом a la Django, но при сборке приложения компилируются в результирующий бинарник
* Подсистема обработки форм (генерация HTML формы по объекту, валидация форм, показ недозаполненной формы)