Skip to content
Browse files

Updating ORM to take care of import cycles problem.

  • Loading branch information...
1 parent 8ca1019 commit ec79feee1622e3ac9a522d8b79225404b6639a3d @alsonkemp committed Jan 5, 2009
Showing with 92 additions and 34 deletions.
  1. +92 −34 Turbinado/Database/ORM/Output.hs
View
126 Turbinado/Database/ORM/Output.hs
@@ -17,49 +17,41 @@ type TypeName = String
-- TODO: This file needs to be completely torn up and generalized.
writeModels ts =
- do writeFile "App/Models/Bases/ModelBase.hs" generateModelBase
+ do writeFile "App/Models/Bases/Common.hs" generateCommon
mapM_ (\(t, (cs, pk)) ->
- let typeName = (capitalizeName t)
- fullName = typeName ++ "Model" in
- do e <- doesFileExist (joinPath ["App/Models", fullName ++ ".hs"])
- when (not e) (writeFile (joinPath ["App/Models", fullName++".hs"]) (generateModelFile typeName) )
- writeFile (joinPath ["App/Models/Bases", fullName ++ "Base.hs"]) (generateModel t typeName pk ts cs)
+ let typeName = (capitalizeName t) in
+ do e <- doesFileExist (joinPath ["App/Models", typeName ++ ".hs"])
+ when (not e) (writeFile (joinPath ["App/Models", typeName++".hs"]) (generateModelFile typeName) )
+ writeFile (joinPath ["App/Models/Bases", typeName ++ "Type.hs"]) (generateType t typeName pk ts cs)
+ writeFile (joinPath ["App/Models/Bases", typeName ++ "Functions.hs"]) (generateFunctions t typeName pk ts cs)
+ writeFile (joinPath ["App/Models/Bases", typeName ++ "Relations.hs"]) (generateRelations t typeName pk ts cs)
) $ M.toList ts
---------------------------------------------------------------------------
-- File templates --
---------------------------------------------------------------------------
-generateModel :: TableName ->
+generateType :: TableName ->
TypeName ->
PrimaryKey ->
Tables ->
Columns ->
String
-generateModel t typeName pk ts cs =
+generateType t typeName pk ts cs =
unlines $
["{- DO NOT EDIT THIS FILE"
," THIS FILE IS AUTOMAGICALLY GENERATED AND YOUR CHANGES WILL BE EATEN BY THE GENERATOR OVERLORD"
,""
- ," All changes should go into the Model file (e.g. App/Models/ExampleModel.hs) and"
- ," not into the base file (e.g. App/Models/Bases/ExampleModelBase.hs) -}"
+ ," All changes should go into the Model file (e.g. App/Models/ExampleModel.hs)"
+ ,"-}"
,""
- ,"module App.Models.Bases." ++ typeName ++ "ModelBase ( "
- ," module App.Models.Bases." ++ typeName ++ "ModelBase, "
- ," module App.Models.Bases.ModelBase) where"
+ ,"module App.Models.Bases." ++ typeName ++ "Type where"
, ""
- , "import App.Models.Bases.ModelBase"
- , "import qualified Database.HDBC as HDBC"
+ , "import App.Models.Bases.Common"
, "import Data.Maybe"
, "import System.Time"
, ""
- , "import Turbinado.Environment.Types"
- , "import Turbinado.Environment.Database"
- , ""
- , "-- Model imports (if any)"
] ++
- nub (generateParentModelImports t ts ++ generateChildModelImports cs) ++
- [""] ++
["-- The data type for this model"] ++
[ "data " ++ typeName ++ " = " ++ typeName ++ " {"
] ++
@@ -69,11 +61,71 @@ generateModel t typeName pk ts cs =
, "instance DatabaseModel " ++ typeName ++ " where"
, " tableName _ = \"" ++ t ++ "\""
, ""
+ ]
+
+generateFunctions :: TableName ->
+ TypeName ->
+ PrimaryKey ->
+ Tables ->
+ Columns ->
+ String
+generateFunctions t typeName pk ts cs =
+ unlines $
+ ["{- DO NOT EDIT THIS FILE"
+ ," THIS FILE IS AUTOMAGICALLY GENERATED AND YOUR CHANGES WILL BE EATEN BY THE GENERATOR OVERLORD"
+ ,""
+ ," All changes should go into the Model file (e.g. App/Models/ExampleModel.hs)"
+ ,"-}"
+ ,""
+ ,"module App.Models.Bases." ++ typeName ++ "Functions where"
+ , ""
+ , "import App.Models.Bases.Common"
+ , "import qualified Database.HDBC as HDBC"
+ , "import Data.Maybe"
+ , "import System.Time"
+ , ""
+ , " -- My type"
+ , "import App.Models.Bases." ++ typeName ++ "Type"
+ , ""
+ , "import Turbinado.Environment.Types"
+ , "import Turbinado.Environment.Database"
+ , ""
] ++
[""] ++
generateHasFindByPrimaryKey t cs typeName pk ++
[""] ++
- generateIsModel t cs typeName ++
+ generateIsModel t cs typeName
+
+generateRelations :: TableName ->
+ TypeName ->
+ PrimaryKey ->
+ Tables ->
+ Columns ->
+ String
+generateRelations t typeName pk ts cs =
+ unlines $
+ ["{- DO NOT EDIT THIS FILE"
+ ," THIS FILE IS AUTOMAGICALLY GENERATED AND YOUR CHANGES WILL BE EATEN BY THE GENERATOR OVERLORD"
+ ,""
+ ," All changes should go into the Model file (e.g. App/Models/ExampleModel.hs)"
+ ,"-}"
+ ,""
+ ,"module App.Models.Bases." ++ typeName ++ "Relations where"
+ , ""
+ , "import App.Models.Bases.Common"
+ , "import qualified Database.HDBC as HDBC"
+ , "import Data.Maybe"
+ , "import System.Time"
+ , ""
+ , " -- Model imports"
+ , "import App.Models.Bases." ++ typeName ++ "Type"
+ , unlines $ generateChildModelImports cs
+ , unlines $ generateParentModelImports t ts
+ , ""
+ , "import Turbinado.Environment.Types"
+ , "import Turbinado.Environment.Database"
+ , ""
+ ] ++
[""] ++
[""] ++
generateHasChildren t cs typeName ++
@@ -82,13 +134,13 @@ generateModel t typeName pk ts cs =
generateHasParents t ts
generateChildModelImports cs =
- map (\ctn -> "import qualified App.Models." ++ capitalizeName ctn ++ "Model as " ++ capitalizeName ctn ++ "Model") $
+ map (\ctn -> "import qualified App.Models.Bases." ++ capitalizeName ctn ++ "Type as " ++ capitalizeName ctn ++ "Type\nimport qualified App.Models.Bases." ++ capitalizeName ctn ++ "Functions as " ++ capitalizeName ctn ++ "Functions") $
nub $
map fst $ concat $
map (\(_, fks, _) -> fks) $ M.elems cs
generateParentModelImports t ts =
- map (\ptn -> "import qualified App.Models." ++ capitalizeName ptn ++ "Model as " ++ capitalizeName ptn ++ "Model") $
+ map (\ptn -> "import qualified App.Models." ++ capitalizeName ptn ++ "Type as " ++ capitalizeName ptn ++ "Type\nimport qualified App.Models." ++ capitalizeName ptn ++ "Functions as " ++ capitalizeName ptn ++ "Functions") $
nub $ filter (not . null) $
map parentFilter $ M.assocs ts
where parentFilter (ptn, (cs, _)) =
@@ -100,18 +152,24 @@ generateModelFile typeName =
unlines $
["module App.Models." ++ typeName ++ "Model"
," ( module App.Models." ++ typeName ++ "Model"
- ," , module App.Models.Bases." ++ typeName ++ "ModelBase"
+ ," , module App.Models.Bases." ++ typeName ++ "Type"
+ ," , module App.Models.Bases." ++ typeName ++ "Finders"
+ ," , module App.Models.Bases." ++ typeName ++ "Relations"
+ ," , module App.Models.Bases.Common"
," ) where"
- ,"import App.Models.Bases." ++ typeName ++ "ModelBase"
+ ,"import App.Models.Bases." ++ typeName ++ "Type"
+ ,"import App.Models.Bases." ++ typeName ++ "Functions"
+ ,"import App.Models.Bases." ++ typeName ++ "Relations"
+ ,"import App.Models.Bases.Common"
]
-generateModelBase :: String
-generateModelBase = unlines $
+generateCommon:: String
+generateCommon = unlines $
["{- DO NOT EDIT THIS FILE"
," THIS FILE IS AUTOMAGICALLY GENERATED AND YOUR CHANGES WILL BE EATEN BY THE GENERATOR OVERLORD -}"
,""
- ,"module App.Models.Bases.ModelBase ("
- ," module App.Models.Bases.ModelBase,"
+ ,"module App.Models.Bases.Common("
+ ," module App.Models.Bases.Common,"
," module Control.Exception,"
," module Control.Monad.Trans,"
," module Data.Int"
@@ -235,10 +293,10 @@ generateHasChildren_t_k :: TableName -> ColumnName -> TableName -> ColumnName ->
generateHasChildren_t_k t cn fkt fkc typeName =
unlines $
["class " ++ capitalizeName t ++ "Has" ++ capitalizeName fkt ++ "ForeignKey parent where"
- ," findAllChild" ++ capitalizeName fkt ++ " :: (HasEnvironment m) => parent -> m [" ++ capitalizeName fkt ++ "Model." ++ capitalizeName fkt ++ "]"
+ ," findAllChild" ++ capitalizeName fkt ++ " :: (HasEnvironment m) => parent -> m [" ++ capitalizeName fkt ++ "Type." ++ capitalizeName fkt ++ "]"
,""
,"instance " ++ capitalizeName t ++ "Has" ++ capitalizeName fkt ++ "ForeignKey (" ++ capitalizeName t ++ ") where"
- ," findAllChild" ++ capitalizeName fkt ++ " p = " ++ capitalizeName fkt ++ "Model.findAllWhere \"" ++ fkc ++ " = ?\" [HDBC.toSql $ " ++ partiallyCapitalizeName cn ++ " p]"
+ ," findAllChild" ++ capitalizeName fkt ++ " p = " ++ capitalizeName fkt ++ "Functions.findAllWhere \"" ++ fkc ++ " = ?\" [HDBC.toSql $ " ++ partiallyCapitalizeName cn ++ " p]"
]
@@ -254,8 +312,8 @@ generateHasParents ctn ts =
generateHasParent_t :: TableName -> ColumnName -> TableName -> ColumnName -> String
generateHasParent_t ptn pcn ctn ccn =
unlines $
- ["parent" ++ capitalizeName ptn ++ " :: (HasEnvironment m) => " ++ capitalizeName ctn ++ " -> m " ++ capitalizeName ptn ++ "Model." ++ capitalizeName ptn
- ,"parent" ++ capitalizeName ptn ++ " self = " ++ capitalizeName ptn ++ "Model.findAllWhere \"" ++ pcn ++ " = ?\" [HDBC.toSql $ " ++ partiallyCapitalizeName ccn ++ " self]"
+ ["parent" ++ capitalizeName ptn ++ " :: (HasEnvironment m) => " ++ capitalizeName ctn ++ " -> m " ++ capitalizeName ptn ++ "Type." ++ capitalizeName ptn
+ ,"parent" ++ capitalizeName ptn ++ " self = " ++ capitalizeName ptn ++ "Functions.findAllWhere \"" ++ pcn ++ " = ?\" [HDBC.toSql $ " ++ partiallyCapitalizeName ccn ++ " self]"
]

0 comments on commit ec79fee

Please sign in to comment.
Something went wrong with that request. Please try again.