merging?

App/Controllers/Home.hs

@@ -9,8 +9,6 @@ performance :: Controller ()
 performance = return ()
 
 hello :: Controller ()
-hello = do e  <- getEnvironment
-           e' <- doIO $ clearLayout e
-           put e'
+hello = clearLayout
 
 

Config/Routes.hs

@@ -1,6 +1,7 @@
 module Config.Routes where
 
-routes = [ "/:controller/:action.:format"
+routes = [ "/:controller/:action/:id"
+         , "/:controller/:action.:format"
          , "/:controller/:action"
          , "/:controller"
          ]

Turbinado/Controller.hs

@@ -1,43 +1,77 @@
 module Turbinado.Controller (
-        getEnvironment,
-        evalController,
         -- limited export from Turbinado.Controller.Monad
         Controller,
         runController,
         get, put,
         -- * Functions
         doIO, catch,
 
-        module Turbinado.Environment,
+        redirectTo,
+        -- * Database
+        quickQuery,
+        quickQuery',
+        run,
+        HDBC.SqlValue(..),
+        HDBC.SqlType(..),
+
+        module Data.Maybe,
+
         module Turbinado.Environment.CodeStore,
+        module Turbinado.Environment.Logger,
         module Turbinado.Environment.Request,
         module Turbinado.Environment.Response,
-        module Turbinado.Environment.Settings
+        module Turbinado.Environment.Settings,
+        module Turbinado.Environment.Types,
+        module Turbinado.Environment.ViewData
         ) where
 
 import Control.Exception (catchDyn)
 import Control.Monad
 import Control.Monad.State
 import Control.Monad.Trans (MonadIO(..))
+import Data.Maybe
 import qualified Network.HTTP as HTTP
 import Prelude hiding (catch)
+import qualified Database.HDBC as HDBC
 
-import Turbinado.Environment
+import Turbinado.Environment.Database
+import Turbinado.Environment.Logger
 import Turbinado.Environment.Request
 import Turbinado.Environment.Response
 import Turbinado.Environment.Settings
+import Turbinado.Environment.Types
+import Turbinado.Environment.ViewData
 import Turbinado.Controller.Monad
 import Turbinado.Environment.CodeStore
 import Turbinado.Utility.General
+import Turbinado.Server.StandardResponse
 
+-- evalController :: Controller () -> Environment -> IO Environment
+-- evalController p = runController p e
 
-evalController :: Controller () -> EnvironmentFilter
-evalController p e = runController p e
+--
+-- * Helper functions
+--
 
+redirectTo :: String -> Controller ()
+redirectTo l = redirectResponse l
 
 --
--- * Environment functions
+-- * Database functions
 --
 
-getEnvironment :: Controller Environment
-getEnvironment = get
+quickQuery :: String -> [HDBC.SqlValue] -> Controller [[HDBC.SqlValue]]
+quickQuery s vs = do e <- get
+                     let c = fromJust $ getDatabase e
+                     doIO $ HDBC.handleSqlError $ HDBC.quickQuery c s vs
+
+quickQuery' :: String -> [HDBC.SqlValue] -> Controller [[HDBC.SqlValue]]
+quickQuery' s vs = do e <- get
+                      let c = fromJust $ getDatabase e
+                      doIO $ HDBC.handleSqlError $ HDBC.quickQuery' c s vs
+
+run :: String -> [HDBC.SqlValue] -> Controller Integer
+run s vs    = do e <- get
+                 let c = fromJust $ getDatabase e
+                 doIO $ HDBC.handleSqlError $  HDBC.run c s vs
+

Turbinado/Controller/Monad.hs

@@ -2,6 +2,10 @@ module Turbinado.Controller.Monad (
         -- * The 'Controller' Monad
         Controller,
         runController,
+        withController,
+
+        get,
+        put,
         -- * Functions
         doIO, catch
         ) where
@@ -13,7 +17,7 @@ import Control.Monad.Trans (MonadIO(..))
 import Data.Maybe
 import Prelude hiding (catch)
 
-import Turbinado.Environment
+import Turbinado.Environment.Types
 import Turbinado.Controller.Exception
 import Turbinado.Utility.General
 
@@ -32,6 +36,9 @@ type Controller = StateT Environment IO
 runController :: Controller () -> Environment -> IO Environment
 runController c e = (execStateT c) e
 
+withController :: (Environment -> Environment) -> Controller a -> Controller a
+withController = withStateT
+
 -- | Execute an IO computation within the Controller monad.
 doIO :: IO a -> Controller a
 doIO = liftIO

Turbinado/Database/ORM/Generator.hs

@@ -1,38 +1,46 @@
 module Turbinado.Database.ORM.Generator where
 
-
+import Control.Monad
+import Data.List
 import qualified Data.Map as M
-
-
-type ConnectionString = String
-type TableName = String
-type ColumnName = String
-type Column = (SqlColDesc, DependentKeys, Boolean)  -- Boolean == isPrimaryKey
-type DependentKeys = [(TableName, ColumnName)]  -- all columns which are targets of foreign keys
-
-type TableColumn = (TableName, ColumnName)
-type TableColumns = M.Map TableColumn Column
-
-generateModels :: FilePath -> IO ()
-generateModels cs fp = do conn <- openDBConnection
-                          ts <- Database.HDBC.getTables conn
-                          ds <- zip ts $ mapM (describeTable conn) ts
-                          let tcs = combineTablesColumns ts ds
-                          pks <- getPrimaryKeys conn t
-                          let tcs' = combinePrimaryKeys tcs pks
-                          fks <- getForeignKeys t
-                          let tcs'' = foldl
+import Data.Maybe
+import Database.HDBC
+
+import Config.Master
+import Turbinado.Database.ORM.Types
+import Turbinado.Database.ORM.Output
+import Turbinado.Database.ORM.PostgreSQL
+
+generateModels ::  IO ()
+generateModels = do conn <- fromJust databaseConnection
+                    ts <- getTables conn
+                    -- TODO: Pull in indices
+                    tcs <- foldM (buildTable conn) (M.empty) ts
+                    writeModels tcs
 
 
-combineTablesColumns :: [TableName] -> [(ColumnName, SqlColDesc)] -> TableColumn
-combineTablesColumsn ts cs =
-    M.fromList $ zipWith (\t (c, d) -> ((t,c), (d, [], False)) ) ts cs 
-
-combinePrimaryKeys :: [(TableName, [ColumnName])] -> TableColumns -> TableColumns
-combinePrimaryKeys pks tcs =
-     foldl (\tcs (t, cs) -> foldl (\c -> M.adjust (\(d,k,_) -> (d, k, True)) (t, c) ) tcs cs) tcs pks
-
-addDependentKey :: (TableColumn, TableColumn) -> TableColumns -> TableColumns
-addDependentKey (parTable, parColumn), ((depTable, depColumn)) t =
-    let c@(d, k, i) = M.lookup (parTable, parColumn) t  in
-    M.insert (parTable, parColumn) (d, k `union` (depTable, depColumn), i)
+buildTable conn tcs t = do ds <- describeTable conn t
+                           let tcs'  = combineDescription t ds tcs
+                           pks <- getPrimaryKeys conn t
+                           let tcs'' = combinePrimaryKeys t pks tcs'
+                           fks <- getForeignKeyReferences conn t
+                           return $ combineForeignKeyReferences t fks tcs''
+
+combineDescription t ds tcs = M.insert t (cols, []) tcs
+  where cols = M.fromList $ 
+                map (\(columnName, columnDescription) -> (columnName, (columnDescription,[]))) ds
+
+combinePrimaryKeys :: TableName -> [ColumnName] -> Tables -> Tables
+combinePrimaryKeys t pks tcs = M.adjust (\(c, _) -> (c,pks)) t tcs
+
+combineForeignKeyReferences :: TableName -> [(ColumnName, TableName, ColumnName)] -> Tables -> Tables
+combineForeignKeyReferences t fks tcs =
+    M.adjust
+      (\(cs, pks) -> (foldl (worker) cs fks, pks))
+        t tcs
+  where worker cs (c, tt, tc) = M.adjust (\(cd, deps) -> (cd, [(tt, tc)] `union` deps)) c cs
+{-
+ - combineTablesColumns :: [TableName] -> [(ColumnName, SqlColDesc)] -> Tables
+ - combineTablesColumsn ts cs =
+ - M.fromList $ zipWith (\t (c, d) -> (t, (c, [])) ) ts cs 
+ -}