Export DString only type and add a testsuite to check monoid laws.

sql-words/sql-words.cabal

@@ -28,6 +28,20 @@ library
 
   default-language:     Haskell2010
 
+test-suite monoids
+  build-depends:         base <5
+                       , Cabal
+                       , cabal-test-compat
+                       , QuickCheck >=2
+                       , sql-words
+
+  type:                detailed-0.9
+  test-module:         MonoidLaw
+
+  hs-source-dirs:      test
+  ghc-options:         -Wall
+
+  default-language:     Haskell2010
 
 source-repository head
   type:       git

sql-words/src/Language/SQL/Keyword/Type.hs

@@ -9,14 +9,14 @@
 --
 -- SQL keyword representation using Haskell data constructors.
 module Language.SQL.Keyword.Type (
-  Keyword (..),
+  Keyword (..), DString,
 
   word,
   wordShow, unwordsSQL
   ) where
 
 import Data.Monoid (mconcat)
-import Language.SQL.Keyword.Internal.Type (Keyword (..), word, wordShow)
+import Language.SQL.Keyword.Internal.Type (Keyword (..), word, wordShow, DString)
 
 
 -- | Concatinate keywords into 'String' like unwords

sql-words/test/MonoidLaw.hs

@@ -0,0 +1,53 @@
+{-# OPTIONS -fno-warn-orphans #-}
+
+module MonoidLaw (tests) where
+
+import Language.SQL.Keyword (Keyword, DString)
+
+import Data.Monoid (Monoid, mempty, (<>))
+import Data.String (fromString)
+import Distribution.TestSuite.Compat (TestList, testList, prop)
+import Test.QuickCheck (Arbitrary (..))
+
+
+leftId :: (Eq a, Monoid a) => a -> Bool
+leftId a = mempty <> a == a
+
+rightId :: (Eq a, Monoid a) => a -> Bool
+rightId a = a <> mempty == a
+
+assoc :: (Eq a, Monoid a) => a -> a -> a -> Bool
+assoc a b c = (a <> b) <> c == a <> (b <> c)
+
+dsLeftId :: DString -> Bool
+dsLeftId =  leftId
+
+dsRightId :: DString -> Bool
+dsRightId =  rightId
+
+dsAssoc :: DString -> DString -> DString -> Bool
+dsAssoc =  assoc
+
+instance Arbitrary DString where
+  arbitrary = fmap read arbitrary
+
+kwLeftId :: Keyword -> Bool
+kwLeftId =  leftId
+
+kwRightId :: Keyword -> Bool
+kwRightId =  rightId
+
+kwAssoc :: Keyword -> Keyword -> Keyword -> Bool
+kwAssoc =  assoc
+
+instance Arbitrary Keyword where
+  arbitrary = fmap fromString arbitrary
+
+tests :: TestList
+tests =  testList [ prop "DString left Id"  dsLeftId
+                  , prop "DString right Id" dsRightId
+                  , prop "DString associativity" dsAssoc
+                  , prop "Keyword left Id"  kwLeftId
+                  , prop "Keyword right Id" kwRightId
+                  , prop "Keyword associativity" kwAssoc
+                  ]