Tidy

src/Database/SqlServer/Definitions/Certificate.hs

@@ -1,7 +1,8 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.SqlServer.Definitions.Certificate where
+module Database.SqlServer.Definitions.Certificate
+       (
+         Certificate
+       , certificateName
+       ) where
 
 import Database.SqlServer.Definitions.Identifiers
 import Database.SqlServer.Definitions.Entity
@@ -43,7 +44,7 @@ instance Arbitrary Certificate where
     str <- elements [Just (addDays x eDay), Nothing]
     ep <- arbitrary
     sub <- arbitrary
-    return $ Certificate {
+    return Certificate {
         certificateName = name
       , activeForBeginDialog = afbd
       , startDate = str

src/Database/SqlServer/Definitions/Collations.hs

@@ -1,4 +1,8 @@
-module Database.SqlServer.Definitions.Collations where
+module Database.SqlServer.Definitions.Collations
+       (
+         Collation
+       , renderCollation
+       ) where
 
 import Test.QuickCheck
 import Text.PrettyPrint

src/Database/SqlServer/Definitions/Credential.hs

@@ -2,7 +2,10 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GADTs #-}
 
-module Database.SqlServer.Definitions.Credential where
+module Database.SqlServer.Definitions.Credential
+       (
+         Credential
+       ) where
 
 import Database.SqlServer.Definitions.Identifiers hiding (unwrap)
 import Database.SqlServer.Definitions.Entity

src/Database/SqlServer/Definitions/DataTypes.hs

@@ -1,10 +1,25 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Database.SqlServer.Definitions.DataTypes where
+module Database.SqlServer.Definitions.DataTypes
+       (
+         Type
+       , renderDataType
+       , collation
+       , renderSparse
+       , storageOptions
+       , rowGuidOptions
+       , storageSize
+       , renderRowGuidConstraint
+       , isRowGuidCol
+       , nullOptions
+       , renderNullConstraint
+       , isTimestamp
+       , renderValue
+       ) where
 
 import Database.SqlServer.Definitions.Collations (Collation)
-import Database.SqlServer.Definitions.Identifiers (ArbUUID(..))
+import Database.SqlServer.Definitions.Identifiers (ArbUUID)
 
 import Text.PrettyPrint
 
@@ -71,10 +86,6 @@ data VarBinaryStorage = SizedRange Range
                       | MaxNoFileStream
                       | MaxFileStream
 
-renderFileStream :: VarBinaryStorage -> Doc
-renderFileStream MaxFileStream = text "FILESTREAM"
-renderFileStream _             = empty
-
 renderVarBinaryStorage :: VarBinaryStorage -> Doc
 renderVarBinaryStorage (SizedRange r)   = renderRange r
 renderVarBinaryStorage MaxFileStream    = text "(max)"
@@ -192,23 +203,24 @@ instance Arbitrary SQLDate where
 
 data SQLDateTime = SQLDateTime UTCTime
 
+dateBetween :: Integer -> Integer -> Gen Day
+dateBetween startYear endYear = do
+  y <- choose (startYear,endYear)
+  m <- choose (1,12)
+  d <- choose (1,31)
+  return (fromGregorian y m d)
+
 instance Arbitrary SQLDateTime where
   arbitrary = do
-    y <- choose (1753,9999)
-    m <- choose (1,12)
-    d <- choose (1,31)
-    let day = fromGregorian y m d
+    day <- dateBetween 1753 9999
     datetime <- choose (0,86400)
     return (SQLDateTime (UTCTime day (secondsToDiffTime datetime)))
 
 data SQLSmallDateTime = SQLSmallDateTime UTCTime
 
 instance Arbitrary SQLSmallDateTime where
   arbitrary = do
-    y <- choose (1900,2078)
-    m <- choose (1,12)
-    d <- choose (1,31)
-    let day = fromGregorian y m d
+    day <- dateBetween 1900 2078
     datetime <- choose (0,86400)
     return (SQLSmallDateTime (UTCTime day (secondsToDiffTime datetime)))
 
@@ -275,7 +287,7 @@ data SQLVariant = SQLVariantInt Int
 instance Arbitrary SQLVariant where
   arbitrary = do
     x <- arbitrary
-    y <- elements [\y -> SQLVariantString (show y), \y -> SQLVariantInt y]
+    y <- elements [SQLVariantString . show, SQLVariantInt]
     return $ y x
 
 data SQLXml = SQLXml String
@@ -468,7 +480,7 @@ renderValue (BigInt _ v) = Just $ (text . show) v
 renderValue (Int _ v) = Just $ (text . show) v
 renderValue (TinyInt _ v) = Just $ (text . show) v
 renderValue (SmallInt _ v) = Just $ (text . show) v
-renderValue (Bit _ b) = Just $ maybe (text "NULL") (\x -> if x then int 1 else int 0) b
+renderValue (Bit _ b) = Just $ maybe (text "NULL") (\x -> int (if x then 1 else  0)) b
 renderValue (SmallMoney _ s) = Just $ text (divideBy10000 $ fromIntegral s)
 renderValue (Money _ s) = Just $ text (divideBy10000 $ fromIntegral s)
 renderValue (Date _ d) = Just $ renderSQLDate d

src/Database/SqlServer/Definitions/Entity.hs

@@ -1,4 +1,8 @@
-module Database.SqlServer.Definitions.Entity where
+module Database.SqlServer.Definitions.Entity
+       (
+         Entity,
+         toDoc
+       ) where
 
 import Text.PrettyPrint
 

src/Database/SqlServer/Definitions/FullTextCatalog.hs

@@ -1,7 +1,10 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Database.SqlServer.Definitions.FullTextCatalog where
+module Database.SqlServer.Definitions.FullTextCatalog
+       (
+         FullTextCatalog
+       ) where
 
 import Database.SqlServer.Definitions.Identifiers
 import Database.SqlServer.Definitions.Entity
@@ -22,7 +25,7 @@ data FullTextCatalog = FullTextCatalog
 derive makeArbitrary ''FullTextCatalog
 
 renderFileGroup :: RegularIdentifier -> Doc
-renderFileGroup n = text "ON FILEGROUP" <+> (renderRegularIdentifier n)
+renderFileGroup n = text "ON FILEGROUP" <+> renderRegularIdentifier n
 
 renderOptions :: Bool -> Doc
 renderOptions True  = text "WITH ACCENT_SENSITIVITY = ON"
@@ -33,5 +36,5 @@ instance Entity FullTextCatalog where
               renderRegularIdentifier (catalogName ftc) $+$
               maybe empty renderFileGroup (filegroup ftc) $+$
               maybe empty renderOptions (accentSensitive ftc) $+$
-              if (asDefault ftc) then text "AS DEFAULT" else empty $+$
+              if asDefault ftc then text "AS DEFAULT" else empty $+$
               text "GO\n"

src/Database/SqlServer/Definitions/FullTextStopList.hs

@@ -1,4 +1,7 @@
-module Database.SqlServer.Definitions.FullTextStopList where
+module Database.SqlServer.Definitions.FullTextStopList
+       (
+         FullTextStopList
+       ) where
 
 import Database.SqlServer.Definitions.Identifiers
 import Database.SqlServer.Definitions.Entity

src/Database/SqlServer/Definitions/Function.hs

@@ -2,7 +2,10 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GADTs #-}
 
-module Database.SqlServer.Definitions.Function where
+module Database.SqlServer.Definitions.Function
+       (
+         Function
+       ) where
 
 import Database.SqlServer.Definitions.Identifiers hiding (unwrap)
 import Database.SqlServer.Definitions.DataTypes
@@ -40,8 +43,8 @@ renderFunctionOptions f
   | not (areThereAnyOptionsSet f) = empty
   | otherwise = text "WITH" <+>
                 vcat (punctuate comma
-                  (filter (/= empty) [ if (encryption f) then (text "ENCRYPTION") else empty
-                                     , if (schemaBinding f) then (text "SCHEMABINDING") else empty
+                  (filter (/= empty) [ if encryption f then text "ENCRYPTION" else empty
+                                     , if schemaBinding f then text "SCHEMABINDING" else empty
                                      , maybe empty renderNullOption (nullOption f) ]))
 
 newtype InputType = InputType Type
@@ -67,7 +70,7 @@ derive makeArbitrary ''Parameter
 newtype ReturnType = ReturnType Type
 
 instance Arbitrary ReturnType where
-  arbitrary = liftM ReturnType $ arbitrary `suchThat` (liftM isJust renderValue)
+  arbitrary = liftM ReturnType $ arbitrary `suchThat` liftM isJust renderValue
 
 renderReturnType :: ReturnType -> Doc
 renderReturnType (ReturnType t) = renderDataType t
@@ -81,7 +84,6 @@ data ScalarFunction = ScalarFunction
      scalarFunctionName :: RegularIdentifier
    , parameters :: [Parameter]
    , returnType :: ReturnType
-   , functionBody :: String
    , functionOption :: FunctionOption
    }
 
@@ -93,7 +95,7 @@ derive makeArbitrary ''Function
 
 instance Entity Function where
   toDoc (ScalarFunctionC f) = text "CREATE FUNCTION" <+> renderRegularIdentifier (scalarFunctionName f) <+>
-                              (parens $ hcat (punctuate comma (map renderParameter (parameters f)))) $+$
+                              parens (hcat (punctuate comma (map renderParameter (parameters f)))) $+$
                               text "RETURNS" <+> renderReturnType (returnType f) $+$
                               renderFunctionOptions (functionOption f) $+$
                               text "AS" $+$

src/Database/SqlServer/Definitions/Identifiers.hs

@@ -2,7 +2,15 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GADTs #-}
 
-module Database.SqlServer.Definitions.Identifiers where
+module Database.SqlServer.Definitions.Identifiers
+       (
+         RegularIdentifier
+       , ArbUUID
+       , ParameterIdentifier        
+       , renderRegularIdentifier
+       , renderParameterIdentifier
+       , unwrap
+       ) where
 
 import Data.DeriveTH
 import Test.QuickCheck

src/Database/SqlServer/Definitions/Login.hs

@@ -21,14 +21,14 @@ derive makeArbitrary ''Login
 
 renderPassword :: RegularIdentifier -> Doc
 renderPassword s = text "WITH PASSWORD = " <>
-                   (quotes (renderRegularIdentifier s))
+                   quotes (renderRegularIdentifier s)
 
 renderMustChange :: Bool -> Doc
 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)) $+$
+  toDoc a = text "CREATE LOGIN" <+> renderRegularIdentifier (loginName a) $+$
             renderPassword (password a)  <+> renderMustChange (mustChange a)
 
 

src/Database/SqlServer/Definitions/MessageType.hs

@@ -2,7 +2,10 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GADTs #-}
 
-module Database.SqlServer.Definitions.MessageType where
+module Database.SqlServer.Definitions.MessageType
+       (
+         MessageType
+       ) where
 
 import Database.SqlServer.Definitions.Identifiers hiding (unwrap)
 import Database.SqlServer.Definitions.User (User,Role,roleName,renderUserName)
@@ -43,7 +46,7 @@ renderValidation WellFormedXml = text "VALIDATION = WELL_FORMED_XML"
 
 instance Entity MessageType where
   toDoc m = maybe empty renderPreRequisites (authorization m) $+$
-            text "CREATE MESSAGE TYPE" <+> (renderRegularIdentifier (messageTypeName m)) $+$
+            text "CREATE MESSAGE TYPE" <+> renderRegularIdentifier (messageTypeName m) $+$
             maybe empty renderAuthorization (authorization m) $+$
             maybe empty renderValidation (validation m) 
 

src/Database/SqlServer/Definitions/Procedure.hs

@@ -2,7 +2,12 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GADTs #-}
 
-module Database.SqlServer.Definitions.Procedure where
+module Database.SqlServer.Definitions.Procedure
+       (
+         Procedure,
+         parameters,
+         procedureName
+       ) where
 
 import Database.SqlServer.Definitions.Identifiers hiding (unwrap)
 import Database.SqlServer.Definitions.DataTypes

src/Database/SqlServer/Definitions/Queue.hs

@@ -90,7 +90,7 @@ renderActivation a = text "ACTIVATION(" <+>
 
 instance Entity Queue where
   toDoc q = maybe empty renderProc (activation q) $+$
-            text "CREATE QUEUE" <+> (renderRegularIdentifier (queueName q)) <+> options $+$ text "GO"
+            text "CREATE QUEUE" <+> renderRegularIdentifier (queueName q) <+> options $+$ text "GO"
     where
       options
         | not $ anySpecified q = empty

src/Database/SqlServer/Definitions/Sequence.hs

@@ -2,11 +2,14 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GADTs #-}
 
-module Database.SqlServer.Definitions.Sequence where
+module Database.SqlServer.Definitions.Sequence
+       (
+         Sequence
+       ) where
 
 import Prelude hiding (cycle)
 
-import Database.SqlServer.Definitions.Identifiers (RegularIdentifier(..), renderRegularIdentifier)
+import Database.SqlServer.Definitions.Identifiers (RegularIdentifier, renderRegularIdentifier)
 import Database.SqlServer.Definitions.Entity
 
 import Text.PrettyPrint
@@ -86,7 +89,7 @@ arbitraryValue (Just TinyInt)  = boundedMaybeInt (0,255)
 arbitraryValue (Just SmallInt) = boundedMaybeInt (- 32768,32767)
 arbitraryValue (Just Int)      = boundedMaybeInt (- 2147483648,214748367)
 arbitraryValue (Just BigInt)   = boundedMaybeInt (- 9223372036854775808,9223372036854775807)
-arbitraryValue _               = oneof [liftM Just $ arbitrary,return Nothing]
+arbitraryValue _               = oneof [liftM Just arbitrary,return Nothing]
 
 arbitraryCacheValue :: Gen (Maybe Integer)
 arbitraryCacheValue = frequency [(50,liftM Just $ choose (1,500)), (50,return Nothing)]
@@ -123,29 +126,29 @@ validIncrementBy' x       min' max' incr' = maybe True (\incr -> abs incr <= dif
     diff  = abs (max'' - min'')
 
 validMinimum :: Maybe NumericType -> Maybe Integer -> Bool
-validMinimum x y = case (numericBounds x) of
+validMinimum x y = case numericBounds x of
   Nothing -> True
   Just (_,max') -> maybe True (< max') y
 
 validMaximum :: Maybe NumericType -> Maybe Integer -> Bool
-validMaximum x y = case (numericBounds x) of
+validMaximum x y = case numericBounds x of
   Nothing -> True
   Just (min',_) -> maybe True (> min') y
 
 instance Arbitrary Sequence where
   arbitrary = do
     nm <- arbitrary
     dataType <- arbitrary
-    minV <- arbitraryValue dataType `suchThat` (validMinimum dataType)
-    maxV <- arbitraryValue dataType `suchThat` (\x -> greaterThanMin minV x && validMaximum dataType x)
-    start <- arbitraryValue dataType `suchThat` (\x -> greaterThanMin minV x && lessThanMax maxV x)
-    increment <- arbitraryValue dataType `suchThat` (validIncrementBy dataType minV maxV)
+    minV <- arbitraryValue dataType `suchThat` validMinimum dataType
+    maxV <- arbitraryValue dataType `suchThat` \x -> greaterThanMin minV x && validMaximum dataType x
+    start <- arbitraryValue dataType `suchThat` \x -> greaterThanMin minV x && lessThanMax maxV x
+    increment <- arbitraryValue dataType `suchThat` validIncrementBy dataType minV maxV
     cyc <- arbitrary
     hasMinValue <- elements [Just, const Nothing]
     hasMaxValue <- elements [Just, const Nothing]
     hasChcValue <- elements [Just, const Nothing]    
     chc <- arbitraryCacheValue
-    return $ Sequence {
+    return Sequence {
         sequenceName = nm
       , sequenceType = dataType
       , startWith = start