Permalink
Browse files

ORM updates; Removing merging on Controllers; Adding documentation

  • Loading branch information...
1 parent 80cccf7 commit 765e0ae686c48f0146e555e92ed507e4964e87a9 @alsonkemp committed Jan 17, 2009
@@ -1,3 +1,4 @@
+import Turbinado.Controller
import App.Models.Page
show :: Controller ()
@@ -1,2 +1,4 @@
+import Turbinado.Controller
+
test :: Controller ()
test = return ()
@@ -1,3 +1,4 @@
+import Turbinado.Controller
show :: Controller ()
show = return ()
@@ -1,3 +1,4 @@
+import Turbinado.Controller
index :: Controller ()
index = return ()
View
@@ -1,3 +1,4 @@
+import Turbinado.Controller
index :: Controller ()
index = return ()
View
@@ -1,5 +1,8 @@
-import App.Models.Page
import qualified Network.URI as URI
+import System.Time
+
+import Turbinado.Controller
+import App.Models.Page
index :: Controller ()
index = do pages <- findAll
@@ -37,5 +40,8 @@ save = do id' <- getSetting_u "id"
App.Models.Page.update p {title = _title, content = _content}
redirectTo $ "/Page/Show/" ++ id'
-
+--test :: Controller ()
+--test = do t <- liftIO getClockTime
+-- App.Models.Page.insert Page {_id = "asdf7", title = "title", content = "content", tester = Just 666, ts = Just t} False
+-- redirectTo $ "/Home/Index"
@@ -1,3 +1,4 @@
+import Turbinado.Controller
show :: Controller ()
show = return ()
@@ -37,5 +37,6 @@ class (DatabaseModel model) =>
class (DatabaseModel model) =>
HasFindByPrimaryKey model primaryKey | model -> primaryKey where
find :: (HasEnvironment m) => primaryKey -> m model
- update :: (HasEnvironment m) => model -> m ()
+ delete :: (HasEnvironment m) => primaryKey -> m ()
+ update :: (HasEnvironment m) => model -> m ()
@@ -35,6 +35,24 @@ instance HasFindByPrimaryKey Page (String) where
HDBC.seErrorMsg = "Too many records found when finding by Primary Key:page : " ++ (show pk)
}
+ delete pk@(pk1) = do
+ conn <- getEnvironment >>= (return . fromJust . getDatabase )
+ res <- liftIO $ HDBC.handleSqlError $ HDBC.run conn ("DELETE FROM page WHERE (_id = ? )") [HDBC.toSql pk1]
+ case res of
+ 0 -> (liftIO $ HDBC.handleSqlError $ HDBC.rollback conn) >>
+ (throwDyn $ HDBC.SqlError
+ {HDBC.seState = "",
+ HDBC.seNativeError = (-1),
+ HDBC.seErrorMsg = "Rolling back. No record found when deleting by Primary Key:page : " ++ (show pk)
+ })
+ 1 -> (liftIO $ HDBC.handleSqlError $ HDBC.commit conn) >> return ()
+ _ -> (liftIO $ HDBC.handleSqlError $ HDBC.rollback conn) >>
+ (throwDyn $ HDBC.SqlError
+ {HDBC.seState = "",
+ HDBC.seNativeError = (-1),
+ HDBC.seErrorMsg = "Rolling back. Too many records deleted when deleting by Primary Key:page : " ++ (show pk)
+ })
+
update m = do
conn <- getEnvironment >>= (return . fromJust . getDatabase )
res <- liftIO $ HDBC.handleSqlError $ HDBC.run conn "UPDATE page SET (_id , content , title) = (?,?,?) WHERE (_id = ? )"
@@ -45,13 +63,19 @@ instance HasFindByPrimaryKey Page (String) where
instance IsModel Page where
insert m returnId = do
conn <- getEnvironment >>= (return . fromJust . getDatabase )
- res <- liftIO $ HDBC.handleSqlError $ HDBC.run conn " INSERT INTO page (_id,content,title) VALUES (?,?,?)"
- [HDBC.toSql $ _id m , HDBC.toSql $ content m , HDBC.toSql $ title m]
- liftIO $ HDBC.handleSqlError $ HDBC.commit conn
- if returnId
- then do i <- liftIO $ HDBC.catchSql (HDBC.handleSqlError $ HDBC.quickQuery' conn "SELECT lastval()" []) (\_ -> HDBC.commit conn >> (return $ [[HDBC.toSql (0 :: Int)]]) )
- return $ HDBC.fromSql $ head $ head i
- else return Nothing
+ res <- liftIO $ HDBC.handleSqlError $ HDBC.run conn (" INSERT INTO page (_id,content,title) VALUES (?,?,?)") ( [HDBC.toSql $ _id m] ++ [HDBC.toSql $ content m] ++ [HDBC.toSql $ title m])
+ case res of
+ 0 -> (liftIO $ HDBC.handleSqlError $ HDBC.rollback conn) >>
+ (throwDyn $ HDBC.SqlError
+ {HDBC.seState = "",
+ HDBC.seNativeError = (-1),
+ HDBC.seErrorMsg = "Rolling back. No record inserted :page : " ++ (show m)
+ })
+ 1 -> liftIO $ HDBC.handleSqlError $ HDBC.commit conn >>
+ if returnId
+ then do i <- liftIO $ HDBC.catchSql (HDBC.handleSqlError $ HDBC.quickQuery' conn "SELECT lastval()" []) (\_ -> HDBC.commit conn >> (return $ [[HDBC.toSql (0 :: Integer)]]) )
+ return $ HDBC.fromSql $ head $ head i
+ else return Nothing
findAll = do
conn <- getEnvironment >>= (return . fromJust . getDatabase )
res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn "SELECT _id , content , title FROM page" []
@@ -62,21 +86,27 @@ instance IsModel Page where
return $ map (\r -> Page (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1)) (HDBC.fromSql (r !! 2))) res
findAllOrderBy op = do
conn <- getEnvironment >>= (return . fromJust . getDatabase )
- res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page ORDER BY ?") [HDBC.toSql op]
+ res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page ORDER BY " ++ op) []
return $ map (\r -> Page (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1)) (HDBC.fromSql (r !! 2))) res
findAllWhereOrderBy ss sp op = do
conn <- getEnvironment >>= (return . fromJust . getDatabase )
- res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page WHERE (" ++ ss ++ ") ORDER BY ? ") (sp ++ [HDBC.toSql op])
+ res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page WHERE (" ++ ss ++ ") ORDER BY " ++ op) sp
return $ map (\r -> Page (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1)) (HDBC.fromSql (r !! 2))) res
findOneWhere ss sp = do
conn <- getEnvironment >>= (return . fromJust . getDatabase )
res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page WHERE (" ++ ss ++ ") LIMIT 1") sp
return $ (\r -> Page (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1)) (HDBC.fromSql (r !! 2))) (head res)
findOneOrderBy op = do
conn <- getEnvironment >>= (return . fromJust . getDatabase )
- res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page ORDER BY ? LIMIT 1") [HDBC.toSql op]
+ res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page ORDER BY " ++ op ++ " LIMIT 1") []
return $ (\r -> Page (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1)) (HDBC.fromSql (r !! 2))) (head res)
findOneWhereOrderBy ss sp op = do
conn <- getEnvironment >>= (return . fromJust . getDatabase )
- res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page WHERE (" ++ ss ++ ") ORDER BY ? LIMIT 1") (sp ++ [HDBC.toSql op])
+ res <- liftIO $ HDBC.handleSqlError $ HDBC.quickQuery' conn ("SELECT _id , content , title FROM page WHERE (" ++ ss ++ ") ORDER BY " ++ op ++" LIMIT 1") sp
return $ (\r -> Page (HDBC.fromSql (r !! 0)) (HDBC.fromSql (r !! 1)) (HDBC.fromSql (r !! 2))) (head res)
+
+deleteWhere :: (HasEnvironment m) => SelectString -> SelectParams -> m Integer
+deleteWhere ss sp = do
+ conn <- getEnvironment >>= (return . fromJust . getDatabase )
+ res <- liftIO $ HDBC.handleSqlError $ HDBC.run conn ("DELETE FROM page WHERE (" ++ ss ++ ") ") sp
+ return res
View
@@ -11,8 +11,8 @@ import Config.App
compileArgs =
[ "-fglasgow-exts"
- , "-fallow-overlapping-instances"
- , "-fallow-undecidable-instances"
+ , "-XOverlappingInstances"
+ , "-XUndecidableInstances"
, "-F", "-pgmFtrhsx"
, "-fno-warn-overlapping-patterns"
, "-odir " ++ compiledDir
@@ -28,6 +28,7 @@ mUserPkgConf = [""]
layoutDir = "App/Layouts"
layoutStub = "Turbinado/Stubs/Layout.hs"
+configDir = "Config"
modelDir = "App/Models"
viewDir = "App/Views"
viewStub = "Turbinado/Stubs/View.hs"
@@ -38,8 +39,6 @@ componentViewStub = "Turbinado/Stubs/ComponentView.hs"
componentControllerDir = "App/Components/Controllers"
componentControllerStub = "Turbinado/Stubs/ComponentController.hs"
-configDir = "Config"
-
staticDirs = ["static", "tmp/cache"]
compiledDir = "tmp/compiled"
View
@@ -15,6 +15,7 @@ module Turbinado.Controller (
module Data.Maybe,
+ module Config.Master,
module Turbinado.Environment.CodeStore,
module Turbinado.Environment.Header,
module Turbinado.Environment.Logger,
@@ -35,6 +36,7 @@ import qualified Network.HTTP as HTTP
import Prelude hiding (catch)
import qualified Database.HDBC as HDBC
+import Config.Master
import Turbinado.Environment.CodeStore
import Turbinado.Environment.Database
import Turbinado.Environment.Header
@@ -1,4 +1,6 @@
-module Turbinado.Database.ORM.Generator where
+module Turbinado.Database.ORM.Generator (
+ generateModels
+) where
import Control.Monad
import Data.List
@@ -11,6 +13,8 @@ import Turbinado.Database.ORM.Types
import Turbinado.Database.ORM.Output
import Turbinado.Database.ORM.PostgreSQL
+-- | Outputs ORM models to App/Models. User configurable files
+-- are in App/Models. Machine generated files are in App/Models/Bases.
generateModels :: IO ()
generateModels = do conn <- fromJust databaseConnection
ts <- getTables conn
Oops, something went wrong.

0 comments on commit 765e0ae

Please sign in to comment.