introduce name on entity

Author: fffej

src/Database/SqlServer/Definition/Certificate.hs

@@ -36,7 +36,7 @@ renderStartDate d = text "START_DATE = '" <> text (filter (/= '-') (show d)) <>
 
 instance Arbitrary Certificate where
   arbitrary = do
-    name <- arbitrary
+    certName <- arbitrary
     afbd <- arbitrary
     eDay <- liftM3 fromGregorian (elements [2016..3000]) (choose(1,12)) (choose(1,31))
     x <- choose(- 1000,- 1)
@@ -45,7 +45,7 @@ instance Arbitrary Certificate where
     ep <- arbitrary
     sub <- arbitrary
     return Certificate {
-        certificateName = name
+        certificateName = certName
       , activeForBeginDialog = afbd
       , startDate = str
       , expiryDate = ex
@@ -54,7 +54,8 @@ instance Arbitrary Certificate where
       }
 
 instance Entity Certificate where
-  toDoc c = text "CREATE CERTIFICATE" <+> renderRegularIdentifier (certificateName c) $+$
+  name = certificateName
+  toDoc c = text "CREATE CERTIFICATE" <+> renderName c $+$
             renderEncryptionByPassword (encryptPassword c) $+$
             hcat (punctuate comma $ filter (/= empty)
                   [ renderSubject (subject c)

src/Database/SqlServer/Definition/Credential.hs

@@ -44,7 +44,8 @@ data Credential = CredentialDefintion
 derive makeArbitrary ''Credential
 
 instance Entity Credential where
-  toDoc s = text "CREATE CREDENTIAL" <+> renderRegularIdentifier (credentialName s) <+>
+  name = credentialName
+  toDoc s = text "CREATE CREDENTIAL" <+> renderName s <+>
             text "WITH IDENTITY =" <+> quotes (renderIdentity (identity s)) <+>
             maybe empty renderSecret (secret s) $+$
             text "GO"

src/Database/SqlServer/Definition/Database.hs

@@ -28,9 +28,9 @@ data MasterKey = MasterKey
 
 derive makeArbitrary ''MasterKey
 
-instance Entity MasterKey where
-  toDoc MasterKey = text "CREATE MASTER KEY ENCRYPTION BY PASSWORD = 'weKKjwehg252t!!'" $+$
-                    text "GO"
+renderMasterKey :: MasterKey -> Doc
+renderMasterKey _ = text "CREATE MASTER KEY ENCRYPTION BY PASSWORD = 'weKKjwehg252t!!'"
+           $+$  text "GO"
 
 data DatabaseDefinition = DatabaseDefinition
                           {
@@ -60,7 +60,7 @@ renderDatabaseDefinition  dd = text "USE master" $+$
                                text "CREATE DATABASE" <+> dbName $+$
                                text "GO" $+$
                                text "USE" <+> dbName $+$
-                               toDoc (masterKey dd) $+$
+                               renderMasterKey (masterKey dd) $+$
                                renderNamedEntities (tables dd) $+$
                                renderNamedEntities (sequences dd) $+$
                                renderNamedEntities (procedures dd) $+$

src/Database/SqlServer/Definition/Entity.hs

@@ -1,12 +1,19 @@
 module Database.SqlServer.Definition.Entity
        (
          Entity,
-         toDoc
+         toDoc,
+         name,
+         renderName
        ) where
 
+import Database.SqlServer.Definition.Identifier
+
 import Text.PrettyPrint
 
 class Entity a where
   toDoc :: a -> Doc
+  name :: a -> RegularIdentifier
+  renderName :: a -> Doc
+  renderName = renderRegularIdentifier . name
 
 

src/Database/SqlServer/Definition/FullTextCatalog.hs

@@ -32,8 +32,9 @@ renderOptions True  = text "WITH ACCENT_SENSITIVITY = ON"
 renderOptions False = text "WITH ACCENT_SENSITIVITY = OFF"
 
 instance Entity FullTextCatalog where
+  name = catalogName
   toDoc ftc = text "CREATE FULLTEXT CATALOG" <+>
-              renderRegularIdentifier (catalogName ftc) $+$
+              renderName ftc $+$ 
               maybe empty renderFileGroup (filegroup ftc) $+$
               maybe empty renderOptions (accentSensitive ftc) $+$
               if asDefault ftc then text "AS DEFAULT" else empty $+$

src/Database/SqlServer/Definition/FullTextStopList.hs

@@ -23,9 +23,10 @@ instance Arbitrary FullTextStopList where
     return (FullTextStopList x y)
 
 instance Entity FullTextStopList where
+  name = stoplistName
   toDoc f = maybe empty toDoc (join (sourceStopList f)) $+$
             text "CREATE FULLTEXT STOPLIST" <+>
-            renderRegularIdentifier (stoplistName f) <+>
+            renderName f <+>
             maybe (text ";") (\q -> text "FROM" <+>
                                maybe (text "SYSTEM STOPLIST;\n") (\x -> renderRegularIdentifier (stoplistName x) <> text ";\n") q <>
                                text "GO\n") (sourceStopList f)

src/Database/SqlServer/Definition/Function.hs

@@ -94,7 +94,8 @@ data Function = ScalarFunctionC ScalarFunction
 derive makeArbitrary ''Function
 
 instance Entity Function where
-  toDoc (ScalarFunctionC f) = text "CREATE FUNCTION" <+> renderRegularIdentifier (scalarFunctionName f) <+>
+  name (ScalarFunctionC f) = scalarFunctionName f
+  toDoc fn@(ScalarFunctionC f) = text "CREATE FUNCTION" <+> renderName fn <+>
                               parens (hcat (punctuate comma (map renderParameter (parameters f)))) $+$
                               text "RETURNS" <+> renderReturnType (returnType f) $+$
                               renderFunctionOptions (functionOption f) $+$

src/Database/SqlServer/Definition/Login.hs

@@ -28,7 +28,8 @@ renderMustChange False = empty
 renderMustChange True = text "MUST_CHANGE" <> comma <> text "CHECK_EXPIRATION=ON"
 
 instance Entity Login where
-  toDoc a = text "CREATE LOGIN" <+> renderRegularIdentifier (loginName a) $+$
+  name = loginName
+  toDoc a = text "CREATE LOGIN" <+> renderName a $+$
             renderPassword (password a)  <+> renderMustChange (mustChange a)
 
 

src/Database/SqlServer/Definition/MessageType.hs

@@ -8,7 +8,7 @@ module Database.SqlServer.Definition.MessageType
        ) where
 
 import Database.SqlServer.Definition.Identifier hiding (unwrap)
-import Database.SqlServer.Definition.User (User,Role,roleName,renderUserName)
+import Database.SqlServer.Definition.User (User,Role)
 import Database.SqlServer.Definition.Entity
 
 import Test.QuickCheck
@@ -36,17 +36,18 @@ renderPreRequisites (Left x)  = toDoc x $+$ text "GO"
 renderPreRequisites (Right x) = toDoc x $+$ text "GO"
 
 renderAuthorization :: Either User Role -> Doc
-renderAuthorization (Left x)  = text "AUTHORIZATION" <+> renderUserName x
-renderAuthorization (Right x) = text "AUTHORIZATION" <+> renderRegularIdentifier (roleName x) 
+renderAuthorization (Left x)  = text "AUTHORIZATION" <+> renderName x
+renderAuthorization (Right x) = text "AUTHORIZATION" <+> renderName x
 
 renderValidation :: Validation -> Doc
 renderValidation None = text "VALIDATION = NONE"
 renderValidation Empty = text "VALIDATION = EMPTY"
 renderValidation WellFormedXml = text "VALIDATION = WELL_FORMED_XML"
 
 instance Entity MessageType where
+  name = messageTypeName
   toDoc m = maybe empty renderPreRequisites (authorization m) $+$
-            text "CREATE MESSAGE TYPE" <+> renderRegularIdentifier (messageTypeName m) $+$
+            text "CREATE MESSAGE TYPE" <+> renderName m $+$
             maybe empty renderAuthorization (authorization m) $+$
             maybe empty renderValidation (validation m) 
 

src/Database/SqlServer/Definition/Procedure.hs

@@ -46,7 +46,8 @@ statementBody :: String
 statementBody = "select 1\n"
 
 instance Entity Procedure where
-  toDoc p = text "CREATE PROCEDURE" <+> renderRegularIdentifier (procedureName p) $+$
+  name = procedureName
+  toDoc p = text "CREATE PROCEDURE" <+> renderName p $+$
                               hcat (punctuate comma (map renderParameter (parameters p))) <+> text "AS" $+$
                               text statementBody $+$
                               text "GO"