Skip to content

Commit 731be7d

Browse files
fffejfffej
committed
Merge pull request #29 from fffej/tidy
Tidy
2 parents 1dbcb2d + db75920 commit 731be7d

16 files changed

Lines changed: 123 additions & 68 deletions

‎src/Database/SqlServer/Definitions/Certificate.hs‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
1-
{-# LANGUAGE DeriveGeneric #-}
2-
{-# LANGUAGE TemplateHaskell #-}
3-
4-
module Database.SqlServer.Definitions.Certificate where
1+
module Database.SqlServer.Definitions.Certificate
2+
(
3+
Certificate
4+
, certificateName
5+
) where
56

67
import Database.SqlServer.Definitions.Identifiers
78
import Database.SqlServer.Definitions.Entity
@@ -43,7 +44,7 @@ instance Arbitrary Certificate where
4344
str <- elements [Just (addDays x eDay), Nothing]
4445
ep <- arbitrary
4546
sub <- arbitrary
46-
return $ Certificate {
47+
return Certificate {
4748
certificateName = name
4849
, activeForBeginDialog = afbd
4950
, startDate = str

‎src/Database/SqlServer/Definitions/Collations.hs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,8 @@
1-
module Database.SqlServer.Definitions.Collations where
1+
module Database.SqlServer.Definitions.Collations
2+
(
3+
Collation
4+
, renderCollation
5+
) where
26

37
import Test.QuickCheck
48
import Text.PrettyPrint

‎src/Database/SqlServer/Definitions/Credential.hs‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,10 @@
22
{-# LANGUAGE TemplateHaskell #-}
33
{-# LANGUAGE GADTs #-}
44

5-
module Database.SqlServer.Definitions.Credential where
5+
module Database.SqlServer.Definitions.Credential
6+
(
7+
Credential
8+
) where
69

710
import Database.SqlServer.Definitions.Identifiers hiding (unwrap)
811
import Database.SqlServer.Definitions.Entity

‎src/Database/SqlServer/Definitions/DataTypes.hs‎

Lines changed: 28 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,25 @@
11
{-# LANGUAGE DeriveGeneric #-}
22
{-# LANGUAGE TemplateHaskell #-}
33

4-
module Database.SqlServer.Definitions.DataTypes where
4+
module Database.SqlServer.Definitions.DataTypes
5+
(
6+
Type
7+
, renderDataType
8+
, collation
9+
, renderSparse
10+
, storageOptions
11+
, rowGuidOptions
12+
, storageSize
13+
, renderRowGuidConstraint
14+
, isRowGuidCol
15+
, nullOptions
16+
, renderNullConstraint
17+
, isTimestamp
18+
, renderValue
19+
) where
520

621
import Database.SqlServer.Definitions.Collations (Collation)
7-
import Database.SqlServer.Definitions.Identifiers (ArbUUID(..))
22+
import Database.SqlServer.Definitions.Identifiers (ArbUUID)
823

924
import Text.PrettyPrint
1025

@@ -71,10 +86,6 @@ data VarBinaryStorage = SizedRange Range
7186
| MaxNoFileStream
7287
| MaxFileStream
7388

74-
renderFileStream :: VarBinaryStorage -> Doc
75-
renderFileStream MaxFileStream = text "FILESTREAM"
76-
renderFileStream _ = empty
77-
7889
renderVarBinaryStorage :: VarBinaryStorage -> Doc
7990
renderVarBinaryStorage (SizedRange r) = renderRange r
8091
renderVarBinaryStorage MaxFileStream = text "(max)"
@@ -192,23 +203,24 @@ instance Arbitrary SQLDate where
192203

193204
data SQLDateTime = SQLDateTime UTCTime
194205

206+
dateBetween :: Integer -> Integer -> Gen Day
207+
dateBetween startYear endYear = do
208+
y <- choose (startYear,endYear)
209+
m <- choose (1,12)
210+
d <- choose (1,31)
211+
return (fromGregorian y m d)
212+
195213
instance Arbitrary SQLDateTime where
196214
arbitrary = do
197-
y <- choose (1753,9999)
198-
m <- choose (1,12)
199-
d <- choose (1,31)
200-
let day = fromGregorian y m d
215+
day <- dateBetween 1753 9999
201216
datetime <- choose (0,86400)
202217
return (SQLDateTime (UTCTime day (secondsToDiffTime datetime)))
203218

204219
data SQLSmallDateTime = SQLSmallDateTime UTCTime
205220

206221
instance Arbitrary SQLSmallDateTime where
207222
arbitrary = do
208-
y <- choose (1900,2078)
209-
m <- choose (1,12)
210-
d <- choose (1,31)
211-
let day = fromGregorian y m d
223+
day <- dateBetween 1900 2078
212224
datetime <- choose (0,86400)
213225
return (SQLSmallDateTime (UTCTime day (secondsToDiffTime datetime)))
214226

@@ -275,7 +287,7 @@ data SQLVariant = SQLVariantInt Int
275287
instance Arbitrary SQLVariant where
276288
arbitrary = do
277289
x <- arbitrary
278-
y <- elements [\y -> SQLVariantString (show y), \y -> SQLVariantInt y]
290+
y <- elements [SQLVariantString . show, SQLVariantInt]
279291
return $ y x
280292

281293
data SQLXml = SQLXml String
@@ -468,7 +480,7 @@ renderValue (BigInt _ v) = Just $ (text . show) v
468480
renderValue (Int _ v) = Just $ (text . show) v
469481
renderValue (TinyInt _ v) = Just $ (text . show) v
470482
renderValue (SmallInt _ v) = Just $ (text . show) v
471-
renderValue (Bit _ b) = Just $ maybe (text "NULL") (\x -> if x then int 1 else int 0) b
483+
renderValue (Bit _ b) = Just $ maybe (text "NULL") (\x -> int (if x then 1 else 0)) b
472484
renderValue (SmallMoney _ s) = Just $ text (divideBy10000 $ fromIntegral s)
473485
renderValue (Money _ s) = Just $ text (divideBy10000 $ fromIntegral s)
474486
renderValue (Date _ d) = Just $ renderSQLDate d

‎src/Database/SqlServer/Definitions/Entity.hs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,8 @@
1-
module Database.SqlServer.Definitions.Entity where
1+
module Database.SqlServer.Definitions.Entity
2+
(
3+
Entity,
4+
toDoc
5+
) where
26

37
import Text.PrettyPrint
48

‎src/Database/SqlServer/Definitions/FullTextCatalog.hs‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,10 @@
11
{-# LANGUAGE DeriveGeneric #-}
22
{-# LANGUAGE TemplateHaskell #-}
33

4-
module Database.SqlServer.Definitions.FullTextCatalog where
4+
module Database.SqlServer.Definitions.FullTextCatalog
5+
(
6+
FullTextCatalog
7+
) where
58

69
import Database.SqlServer.Definitions.Identifiers
710
import Database.SqlServer.Definitions.Entity
@@ -22,7 +25,7 @@ data FullTextCatalog = FullTextCatalog
2225
derive makeArbitrary ''FullTextCatalog
2326

2427
renderFileGroup :: RegularIdentifier -> Doc
25-
renderFileGroup n = text "ON FILEGROUP" <+> (renderRegularIdentifier n)
28+
renderFileGroup n = text "ON FILEGROUP" <+> renderRegularIdentifier n
2629

2730
renderOptions :: Bool -> Doc
2831
renderOptions True = text "WITH ACCENT_SENSITIVITY = ON"
@@ -33,5 +36,5 @@ instance Entity FullTextCatalog where
3336
renderRegularIdentifier (catalogName ftc) $+$
3437
maybe empty renderFileGroup (filegroup ftc) $+$
3538
maybe empty renderOptions (accentSensitive ftc) $+$
36-
if (asDefault ftc) then text "AS DEFAULT" else empty $+$
39+
if asDefault ftc then text "AS DEFAULT" else empty $+$
3740
text "GO\n"

‎src/Database/SqlServer/Definitions/FullTextStopList.hs‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,7 @@
1-
module Database.SqlServer.Definitions.FullTextStopList where
1+
module Database.SqlServer.Definitions.FullTextStopList
2+
(
3+
FullTextStopList
4+
) where
25

36
import Database.SqlServer.Definitions.Identifiers
47
import Database.SqlServer.Definitions.Entity

‎src/Database/SqlServer/Definitions/Function.hs‎

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,10 @@
22
{-# LANGUAGE TemplateHaskell #-}
33
{-# LANGUAGE GADTs #-}
44

5-
module Database.SqlServer.Definitions.Function where
5+
module Database.SqlServer.Definitions.Function
6+
(
7+
Function
8+
) where
69

710
import Database.SqlServer.Definitions.Identifiers hiding (unwrap)
811
import Database.SqlServer.Definitions.DataTypes
@@ -40,8 +43,8 @@ renderFunctionOptions f
4043
| not (areThereAnyOptionsSet f) = empty
4144
| otherwise = text "WITH" <+>
4245
vcat (punctuate comma
43-
(filter (/= empty) [ if (encryption f) then (text "ENCRYPTION") else empty
44-
, if (schemaBinding f) then (text "SCHEMABINDING") else empty
46+
(filter (/= empty) [ if encryption f then text "ENCRYPTION" else empty
47+
, if schemaBinding f then text "SCHEMABINDING" else empty
4548
, maybe empty renderNullOption (nullOption f) ]))
4649

4750
newtype InputType = InputType Type
@@ -67,7 +70,7 @@ derive makeArbitrary ''Parameter
6770
newtype ReturnType = ReturnType Type
6871

6972
instance Arbitrary ReturnType where
70-
arbitrary = liftM ReturnType $ arbitrary `suchThat` (liftM isJust renderValue)
73+
arbitrary = liftM ReturnType $ arbitrary `suchThat` liftM isJust renderValue
7174

7275
renderReturnType :: ReturnType -> Doc
7376
renderReturnType (ReturnType t) = renderDataType t
@@ -81,7 +84,6 @@ data ScalarFunction = ScalarFunction
8184
scalarFunctionName :: RegularIdentifier
8285
, parameters :: [Parameter]
8386
, returnType :: ReturnType
84-
, functionBody :: String
8587
, functionOption :: FunctionOption
8688
}
8789

@@ -93,7 +95,7 @@ derive makeArbitrary ''Function
9395

9496
instance Entity Function where
9597
toDoc (ScalarFunctionC f) = text "CREATE FUNCTION" <+> renderRegularIdentifier (scalarFunctionName f) <+>
96-
(parens $ hcat (punctuate comma (map renderParameter (parameters f)))) $+$
98+
parens (hcat (punctuate comma (map renderParameter (parameters f)))) $+$
9799
text "RETURNS" <+> renderReturnType (returnType f) $+$
98100
renderFunctionOptions (functionOption f) $+$
99101
text "AS" $+$

‎src/Database/SqlServer/Definitions/Identifiers.hs‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,15 @@
22
{-# LANGUAGE TemplateHaskell #-}
33
{-# LANGUAGE GADTs #-}
44

5-
module Database.SqlServer.Definitions.Identifiers where
5+
module Database.SqlServer.Definitions.Identifiers
6+
(
7+
RegularIdentifier
8+
, ArbUUID
9+
, ParameterIdentifier
10+
, renderRegularIdentifier
11+
, renderParameterIdentifier
12+
, unwrap
13+
) where
614

715
import Data.DeriveTH
816
import Test.QuickCheck

‎src/Database/SqlServer/Definitions/Login.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,14 +21,14 @@ derive makeArbitrary ''Login
2121

2222
renderPassword :: RegularIdentifier -> Doc
2323
renderPassword s = text "WITH PASSWORD = " <>
24-
(quotes (renderRegularIdentifier s))
24+
quotes (renderRegularIdentifier s)
2525

2626
renderMustChange :: Bool -> Doc
2727
renderMustChange False = empty
2828
renderMustChange True = text "MUST_CHANGE" <> comma <> text "CHECK_EXPIRATION=ON"
2929

3030
instance Entity Login where
31-
toDoc a = text "CREATE LOGIN" <+> (renderRegularIdentifier (loginName a)) $+$
31+
toDoc a = text "CREATE LOGIN" <+> renderRegularIdentifier (loginName a) $+$
3232
renderPassword (password a) <+> renderMustChange (mustChange a)
3333

3434

0 commit comments

Comments
 (0)