diff --git a/Blog/Blog b/Blog/Blog
deleted file mode 100755
index c781c57..0000000
Binary files a/Blog/Blog and /dev/null differ
diff --git a/Framework/Cache.hs b/Framework/Cache.hs
index e3e6938..be9ff14 100644
--- a/Framework/Cache.hs
+++ b/Framework/Cache.hs
@@ -75,14 +75,19 @@ instance CacheBackend FakeBackend where
cunset _ _ = return True
cfree _ = return ()
-initCache' :: String -> String -> IO CacheConnection
+-- | Initialize cache
+initCache' :: String -- ^ Cache backend
+ -> String -- ^ Path to cache (backend-specific)
+ -> IO CacheConnection
initCache' "memcached" s = CConnection `fmap` (cinit s :: IO MemcacheBackend)
initCache' "filesystem" s = CConnection `fmap` (cinit s :: IO FilesystemBackend)
initCache' "fake" s = CConnection `fmap` (cinit s :: IO FakeBackend)
--- | Init cache backend. Backend type is given in second argument,
+-- | Get connection to cache backend. Backend type is given in second argument,
-- i.e. : initCache pool ("memcached", "localhost:11211").
-initCache :: MPool CacheConnection -> (String,String) -> IO (Int,CacheConnection)
+initCache :: MPool CacheConnection -- ^ Pool of cache connections
+ ->(String,String) -- ^ (cache backend, cache path)
+ -> IO (Int,CacheConnection) -- ^ (Index in the pool, connection)
initCache mpool x = acquire mpool x (\(backend, s) -> initCache' backend s)
-- | Get data from cache (from given connection)
@@ -93,13 +98,18 @@ cGet (CConnection b) name = cget b name
cPut :: (Serializable v) => CacheConnection -> String -> v -> IO Bool
cPut (CConnection b) name value = cput b name value
+-- | Unset key in cache
cUnset :: CacheConnection -> String -> IO Bool
cUnset (CConnection b) name = cunset b name
-- | Free cache backend
-cFree :: MPool CacheConnection -> Int -> CacheConnection -> IO ()
+cFree :: MPool CacheConnection -- ^ Pool of connections
+ -> Int -- ^ Index in the pool
+ -> CacheConnection -- ^ Connection
+ -> IO ()
cFree mpool n conn = free mpool n conn
+-- | Actually disconnect from cache
cDisconnect :: CacheConnection -> IO ()
cDisconnect (CConnection b) = cfree b
@@ -110,7 +120,12 @@ cDisconnect (CConnection b) = cfree b
-- | cached cConnection name key function argument
-- Executes given function with given argument, caching the result
-- (under given function name and item key)
-cached :: (Serializable k, Serializable v) => CacheConnection -> String -> k -> (a -> v) -> a -> IO v
+cached :: (Serializable k, Serializable v) => CacheConnection
+ -> String -- ^ Cache variable (prefix of cache key)
+ -> k -- ^ Key in the cache (suffix)
+ -> (a -> v) -- ^ Function to cache
+ -> a -- ^ Function's argument
+ -> IO v
cached (CConnection b) name k f x =
do c <- cget b key
-- putStrLn $ "Server answer: "++(showC c)
diff --git a/Framework/Http/HTTPServer.hs b/Framework/Http/HTTPServer.hs
index d4b4187..6093aba 100644
--- a/Framework/Http/HTTPServer.hs
+++ b/Framework/Http/HTTPServer.hs
@@ -24,6 +24,7 @@ import Framework.Utils
import Framework.Http.Response
import Framework.Http.Middlewares
+-- | Send a file
sendfile :: String -> IO Response
sendfile filename = do
body <- readFile filename
@@ -31,6 +32,7 @@ sendfile filename = do
where mime = chooseMime filename
+-- | Just serve static files
serveStatic :: StrAction
serveStatic ac s = Just $ serveStatic' ac s
@@ -57,6 +59,7 @@ serveStatic' ac resource =
choose "" = basedir++"/index.html"
choose x = basedir ++"/"++x
+-- | This function is called on each HTTP request
httpWorker :: StaticConfig -> URLConf -> Request -> IO Response
httpWorker hap conf req@(Request {reqURI = URI {uriPath}}) = do
let s = unEscapeString $ reqBody req
@@ -76,7 +79,11 @@ freePools dbPool cPool = do
freeAll cPool cDisconnect
exitWith ExitSuccess
-serveHttp :: Int -> StaticConfig -> URLConf -> IO ()
+-- | Start HTTP server
+serveHttp :: Int -- ^ TCP port number
+ -> StaticConfig -- ^ Server config
+ -> URLConf -- ^ URL dispatcher config
+ -> IO ()
serveHttp port hap conf = do
dbPool <- emptyPool 10
cPool <- emptyPool 10
diff --git a/Framework/Pool.hs b/Framework/Pool.hs
index 00052d9..6d9411c 100644
--- a/Framework/Pool.hs
+++ b/Framework/Pool.hs
@@ -15,12 +15,16 @@ type MPool a = MVar (Pool a)
instance Show (MPool a) where
show _ = "<Pool>"
+-- | Return an empty pool with N items
emptyPool :: Int -> IO (MPool a)
emptyPool n = newMVar (replicate n NotConnected)
-acquire :: MPool a -> c -> (c -> IO a) -> IO (Int,a)
-acquire var x f = do
- modifyMVar var (findConnection f x)
+-- | Get connection from pool
+acquire :: MPool a -- ^ Pool
+ -> c -- ^ Some data for connect
+ -> (c -> IO a) -- ^ Actual connect function
+ -> IO (Int,a) -- ^ (Index in the pool, connection)
+acquire mpool x f = modifyMVar mpool (findConnection f x)
findConnection :: (c -> IO a) -> c -> Pool a -> IO (Pool a, (Int,a))
findConnection f x pool = findConnection' [] 0 x pool
@@ -34,13 +38,20 @@ findConnection f x pool = findConnection' [] 0 x pool
res <- f x
return (xs++[Busy res], (i+1,res))
-free :: MPool a -> Int -> a -> IO ()
-free var n res = modifyMVar_ var (freeConnection n res)
+-- | Free connection
+free :: MPool a -- ^ Pool
+ -> Int -- ^ Index in the pool
+ -> a -- ^ Connection
+ -> IO ()
+free mpool n res = modifyMVar_ mpool (freeConnection n res)
freeConnection :: Int -> a -> Pool a -> IO (Pool a)
freeConnection i res pool = return $ (take i pool)++[Free res]++(drop (i+1) pool)
-freeAll :: MPool a -> (a -> IO ()) -> IO ()
+-- | Free (actually, disconnect) all connections in the pool
+freeAll :: MPool a -- ^ Pool
+ -> (a -> IO ()) -- ^ Disconnect function
+ -> IO ()
freeAll mpool f = withMVar mpool (mapM_ $ free' f)
where free' _ NotConnected = return ()
free' f (Busy res) = f res
diff --git a/Framework/README.ru b/Framework/README.ru
new file mode 100644
index 0000000..9e8696c
--- /dev/null
+++ b/Framework/README.ru
@@ -0,0 +1,14 @@
+Это фреймворк (не очень высокого уровня, на настоящий момент) для создания web-приложений на Haskell.
+
+Состоит он из следующих частей:
+
+ * HTTP сервер (используется доработанный Network.Shed.Httpd)
+ * Модуль для работы с Cookies
+ * Модуль для работы с пользовательскими сессиями (в настоящий момент, данные сессий хранятся в файлах, но можно написать другой backend)
+ * Модуль для кэширования чего угодно (бэкенды - filesystem, memcached и fake)
+ * URL dispatcher
+ * Модуль для работы с БД (использует HDBC, в настоящий момент полноценно работает только с PostgreSQL, sqlite3 поддерживает не все запросы)
+ * EDSL для описания моделей данных (таблиц БД)
+ * EDSL для формирования SQL-запросов
+ * Templating Engine - шаблоны пишутся в отдельных файлах с синтаксисом a la Django, но при сборке приложения компилируются в результирующий бинарник
+ * Подсистема обработки форм (генерация HTML формы по объекту, валидация форм, показ недозаполненной формы)
diff --git a/Framework/Storage.hs b/Framework/Storage.hs
index 96f9336..1ee6bc1 100644
--- a/Framework/Storage.hs
+++ b/Framework/Storage.hs
@@ -20,20 +20,26 @@ import Framework.Models
import Framework.Pool
-- | Connect to DB
-connect :: String -- ^ DB backend
- -> String -- ^ DB connection path (format is backend-specific)
- -> IO DBConnection
-connect "sqlite3" file = DBC `fmap` (Sqlite3.connectSqlite3 file)
-connect "psql" str = DBC `fmap` (PostgreSQL.connectPostgreSQL str)
+connect' :: String -- ^ DB backend
+ -> String -- ^ DB connection path (format is backend-specific)
+ -> IO DBConnection
+connect' "sqlite3" file = DBC `fmap` (Sqlite3.connectSqlite3 file)
+connect' "psql" str = DBC `fmap` (PostgreSQL.connectPostgreSQL str)
--- | Connect to DB, get parameters from "ActionConfig"
-connect' :: MPool DBConnection -> StaticConfig -> IO (Int,DBConnection)
-connect' var hp = acquire var hp (\c -> connect (dbDriver c) (dbPath c))
+-- | Connect to DB, get parameters from "StaticConfig"
+connect :: MPool DBConnection -- ^ Pool of connections
+ -> StaticConfig --
+ -> IO (Int,DBConnection) -- ^ (Index in the pool, connection)
+connect var hp = acquire var hp (\c -> connect' (dbDriver c) (dbPath c))
--- | Disconnect from DB
-disconnect :: ActionConfig -> Int -> DBConnection -> IO ()
+-- | Free DB connection
+disconnect :: ActionConfig
+ -> Int -- ^ Index of connection in the pool
+ -> DBConnection
+ -> IO ()
disconnect ac n dbc = free (dbpool $ httpParams ac) n dbc
+-- | Disconnect from DB
disconnect' :: DBConnection -> IO ()
disconnect' (DBC conn) = D.disconnect conn
@@ -50,6 +56,7 @@ query (DBC conn) sql params = D.quickQuery conn sql params
query' :: DBConnection -> String -> [D.SqlValue] -> IO [[D.SqlValue]]
query' (DBC conn) sql params = D.quickQuery' conn sql params
+-- | Commit DB transaction
commit :: DBConnection -> IO ()
commit (DBC conn) = D.commit conn
diff --git a/Framework/Wrapper.hs b/Framework/Wrapper.hs
index 2188144..6cc268b 100644
--- a/Framework/Wrapper.hs
+++ b/Framework/Wrapper.hs
@@ -11,10 +11,12 @@ import qualified Framework.Cache as Cache
import Framework.Types
import Framework.Utils
+-- | Prepare ActionConfig for controller. This connects to DB etc.
+-- Returns (ActionConfig, WhetherToAddSessionCookie)
mkActionConfig :: StaticConfig -> Request -> IO (ActionConfig,Bool)
mkActionConfig hp rq = do
ed <- expirationDate
- (i,conn) <- Storage.connect' (dbpool hp) hp
+ (i,conn) <- Storage.connect (dbpool hp) hp
sb <- Sessions.initSessions (sessionsDriver hp) (sessionsPath hp)
sess <- Sessions.session sb rq
let (sid,mm,addSession) = case sess of
@@ -35,6 +37,7 @@ mkActionConfig hp rq = do
}
return (conf,addSession)
+-- | Free ActionConfig: disconnect from DB etc.
acFree :: ActionConfig -> IO ()
acFree ac = do
Storage.disconnect ac (dbpoolIndex ac) (dbconnection ac)