Work in progress: redesign of the parser

Hedsql.cabal

@@ -81,3 +81,21 @@ test-suite tests
                    tests
   main-is:         Test.hs
 
+test-suite integration
+  type:            exitcode-stdio-1.0
+  x-uses-tf:       true
+  ghc-options:     -Wall -rtsopts
+  build-depends:   
+                   base >= 4,
+                   HUnit >= 1.2,
+                   QuickCheck >= 2.4,
+                   test-framework >= 0.4.1,
+                   test-framework-quickcheck2,
+                   test-framework-hunit,
+                   random >=1.0.1
+  other-modules:   
+                          Hedsql.Default
+  hs-source-dirs:  
+                   src,
+                   tests/IntegrationTests
+  main-is:         Test.hs

Setup.hs

@@ -1,2 +1,2 @@
 import Distribution.Simple
-main = defaultMain
+main = defaultMain

src/Hedsql/Common/Constructor.hs

@@ -106,6 +106,7 @@ module Hedsql.Common.Constructor
     , module Hedsql.Common.Constructor.Operators
     , module Hedsql.Common.Constructor.Select
     , module Hedsql.Common.Constructor.Tables
+    , module Hedsql.Common.Constructor.TablesManipulation
     , module Hedsql.Common.Constructor.Types
     , module Hedsql.Common.Constructor.Values
     ) where
@@ -117,5 +118,6 @@ import Hedsql.Common.Constructor.DataManipulation
 import Hedsql.Common.Constructor.Operators
 import Hedsql.Common.Constructor.Select
 import Hedsql.Common.Constructor.Tables
+import Hedsql.Common.Constructor.TablesManipulation
 import Hedsql.Common.Constructor.Values
 import Hedsql.Common.Constructor.Types

src/Hedsql/Common/Constructor/DataManipulation.hs

@@ -58,7 +58,7 @@ assign ::
 assign c value = Assignment (column c) (toAssignedVal value)
 
 -- | Create a DELETE FROM statement.
-deleteFrom :: TableConstructor a => a -> Delete
+deleteFrom :: TableConstructor a => a -> Delete a
 deleteFrom t = Delete (table t) Nothing
 
 -- | Create an INSERT INTO statement.

src/Hedsql/Common/Constructor/TablesManipulation.hs

@@ -89,19 +89,19 @@ defaultValue = Default . toExpr
 -- | Create a DROP TABLE statement.
 dropTable ::
        String -- ^ Name of the table. 
-    -> DropTable
+    -> DropTable a
 dropTable = DropTable False . table
 
 dropTableIfExists ::
        TableConstructor a
     => a -- ^ Table or name of the table.
-    -> DropTable
+    -> DropTable a
 dropTableIfExists name = DropTable True $ table name
 
 -- | Create a DROP VIEW query.
 dropView ::
        String -- ^ Name of the view.
-    -> DropView
+    -> DropView a
 dropView = DropView
 
 -- | Create a FOREIGN KEY constraint.

src/Hedsql/Common/DataStructure/Base.hs

@@ -1,25 +1,48 @@
--- file : Hedsql/Common/DataStructure/base
-
 {-|
-    Data type system allowing the representation of SQL in haskell.
-    At the exception of its lenses, this module should not be directly used.
-    It is an "internal machinery" on which are then builds classes allowing the
-    easy generation of such SQL data which can then be later convert them to
-    SQL strings.
--}
+Module      : Hedsql/Common/DataStructure/Base.hs
+Description : Constructor functions for columns.
+Copyright   : (c) Leonard Monnier, 2014
+License     : GPL-3
+Maintainer  : leonard.monnier@gmail.com
+Stability   : experimental
+Portability : portable
 
+Data type system allowing the representation of SQL in haskell.
+At the exception of its lenses, this module should not be directly used.
+It is an "internal machinery" on which are then builds classes allowing the
+easy generation of such SQL data which can then be later convert them to
+SQL strings.
+-}
 module Hedsql.Common.DataStructure.Base (
       module Hedsql.Common.DataStructure.Create
     , module Hedsql.Common.DataStructure.Delete
     , module Hedsql.Common.DataStructure.Drop
     , module Hedsql.Common.DataStructure.Insert
     , module Hedsql.Common.DataStructure.Select
     , module Hedsql.Common.DataStructure.Update
+    , Statement
     ) where
 
 import Hedsql.Common.DataStructure.Create
 import Hedsql.Common.DataStructure.Delete
 import Hedsql.Common.DataStructure.Drop
 import Hedsql.Common.DataStructure.Insert
 import Hedsql.Common.DataStructure.Select
-import Hedsql.Common.DataStructure.Update
+import Hedsql.Common.DataStructure.Update
+
+-- private functions.
+
+-- public functions.
+
+-- | All possible SQL statements which can be constructed using Hedsql.
+data Statement a =
+      CreateTableStmt (CreateTable a)
+    | CreateViewStmt (CreateView a)
+    | DeleteStmt (Delete a)
+    | DropTableStmt (DropTable a)
+    | DropViewStmt (DropView a)
+    | InsertStmt (Insert a)
+    | SelectQueryStmt (Select a)
+    | UpdateStmt (Update a)
+    | Statements [Statement a] -- ^ Combination of many statements.
+      deriving (Show)

src/Hedsql/Common/DataStructure/Create.hs

@@ -1,51 +1,65 @@
--- file : Hedsql/Common/DataStructure/Create
 {-# LANGUAGE TemplateHaskell #-}
 
 {-|
-    CREATE statement data type definitions.
+Module      : Hedsql/Common/DataStructure/Create.hs
+Description : Constructor functions for columns.
+Copyright   : (c) Leonard Monnier, 2014
+License     : GPL-3
+Maintainer  : leonard.monnier@gmail.com
+Stability   : experimental
+Portability : portable
+
+CREATE statement data type definitions.
 -}
 
 module Hedsql.Common.DataStructure.Create where
 
 import Hedsql.Common.DataStructure.Select
 import Control.Lens
 
+-- | Timing of a constraint.
+data ConstraintTiming = ConstraintTiming
+    {
+       _constraintTimingType  :: ConstraintTimingType
+     , _constraintTimingCheck :: ConstraintTimingCheck
+    } deriving (Show)
+
+-- | Type of a timing constraint.
+data ConstraintTimingType =
+      Deferable
+    | NotDeferable
+      deriving (Show)
+
+-- | Timing of a timing constraint.
+data ConstraintTimingCheck =
+      InitiallyImmediate
+    | InitiallyDeferred
+      deriving (Show)
+
 -- | CREATE TABLE statement.
-data CreateTable = CreateTable {
+data CreateTable a = CreateTable
+    {
       _createTableIfNotExistParam :: Bool
-    , _createTableTable :: Table
-    , _createTableCols :: [Column]
-    , _createTableConstraints :: Maybe [TableConstraint]
-} deriving (Show)
+    , _createTableTable           :: Table a
+    , _createTableCols            :: [Column a]
+    , _createTableConstraints     :: Maybe [TableConstraint a]
+    } deriving (Show)
 
 -- | CREATE VIEW query.
-data CreateView = CreateView {
-      _viewName :: [Char]
-    , _viewSelect :: SelectQuery
-}
-
--- | Table constraints to be used in CREATE statement.
-data TableConstraint = TableConstraint {
-      _tableConstraintName :: Maybe String
-    , _tableConstraintConstraint :: TableConstraintType
-    , _tableConstraintTiming :: Maybe ConstraintTiming
-} deriving (Show)
-
--- | Table constraints types used in CREATE statement.
-data TableConstraintType =
-      ForeignKey [Column] ForeignKeyClause
-    | TableConstraintPrimaryKey [Column]
-    | TableConstraintUnique [Column]
-    | TableConstraintCheck Condition
-      deriving (Show)
+data CreateView a = CreateView
+    {
+      _viewName   :: [Char]
+    , _viewSelect :: Select a
+    } deriving (Show)
 
 -- | Foreign key clause to be used in a table constraint of a CREATE statement.
-data ForeignKeyClause = ForeignKeyClause {
-      _foreignKeyClauseTable :: Table
-    , _foreignKeyClauseCols :: [Column]
-    , _foreignKeyMatch :: Maybe Match
+data ForeignKeyClause a = ForeignKeyClause
+    {
+      _foreignKeyClauseTable  :: Table a
+    , _foreignKeyClauseCols   :: [Column a]
+    , _foreignKeyMatch        :: Maybe Match
     , _foreignKeyClauseAction :: Maybe OnAction
-} deriving (Show)
+    } deriving (Show)
 
 -- | Foreign key match type.
 data Match =
@@ -54,17 +68,21 @@ data Match =
     | Simple
       deriving (Show)
 
--- | Timing of a constraint.
-data ConstraintTiming = ConstraintTiming {
-       _constraintTimingType :: ConstraintTimingType
-     , _constraintTimingCheck :: ConstraintTimingCheck
-} deriving (Show)
-
--- | Type of a timing constraint.
-data ConstraintTimingType = Deferable | NotDeferable deriving (Show)
+-- | Table constraints to be used in CREATE statement.
+data TableConstraint a = TableConstraint
+    {
+      _tableConstraintName       :: Maybe String
+    , _tableConstraintConstraint :: TableConstraintType a
+    , _tableConstraintTiming     :: Maybe ConstraintTiming
+    } deriving (Show)
 
--- | Timing of a timing constraint.
-data ConstraintTimingCheck = InitiallyImmediate | InitiallyDeferred deriving (Show)
+-- | Table constraints types used in CREATE statement.
+data TableConstraintType a =
+      ForeignKey [Column a] (ForeignKeyClause a)
+    | TableConstraintPrimaryKey [Column a]
+    | TableConstraintUnique [Column a]
+    | TableConstraintCheck (Condition a)
+      deriving (Show)
 
 -- Make the lenses.
 makeLenses ''ConstraintTiming

src/Hedsql/Common/DataStructure/Delete.hs

@@ -1,19 +1,36 @@
--- file : Hedsql/Common/DataStructure/Delete
 {-# LANGUAGE TemplateHaskell #-}
 
 {-|
-    DELETE statement data type definitions.
--}
+Module      : Hedsql/Common/DataStructure/Delete.hs
+Description : DELETE statement data type definition.
+Copyright   : (c) Leonard Monnier, 2014
+License     : GPL-3
+Maintainer  : leonard.monnier@gmail.com
+Stability   : experimental
+Portability : portable
 
-module Hedsql.Common.DataStructure.Delete where
+DELETE statement data type definitions.
+-}
+module Hedsql.Common.DataStructure.Delete
+    (
+      Delete
+    , deleteTable
+    , deleteWhere
+    ) where
 
 import Hedsql.Common.DataStructure.Select
 import Control.Lens
 
--- | DELETE query.
-data Delete = Delete {
-      _deleteTable :: Table
-    , _deleteWherePart :: Maybe Where
-} deriving (Show)
+-- Private.
+
+-- Public.
+
+-- | DELETE statement.
+data Delete a = Delete
+    {
+      _deleteTable :: Table a
+    , _deleteWhere :: Maybe (Where a)
+    } deriving (Show)
 
+-- Make the lenses.
 makeLenses ''Delete

src/Hedsql/Common/DataStructure/Drop.hs

@@ -1,25 +1,38 @@
--- file : Hedsql/Common/DataStructure/Drop
 {-# LANGUAGE TemplateHaskell #-}
 
 {-|
-    DROP statements data type definitions.
--}
+Module      : Hedsql/Common/DataStructure/Drop.hs
+Description : Constructor functions for columns.
+Copyright   : (c) Leonard Monnier, 2014
+License     : GPL-3
+Maintainer  : leonard.monnier@gmail.com
+Stability   : experimental
+Portability : portable
 
+DROP statements data type definitions.
+-}
 module Hedsql.Common.DataStructure.Drop where
 
 import Hedsql.Common.DataStructure.Select
+
 import Control.Lens
 
+-- Private functions.
+
+-- Public functions.
+
 -- | DROP TABLE statement.
-data DropTable = DropTable {
+data DropTable a = DropTable
+    {
       _dropTableIfExistsParam :: Bool
-    , _dropTableTable :: Table
-} deriving (Show)
+    , _dropTableTable         :: Table a
+    } deriving (Show)
 
 -- | DROP VIEW statement.
-data DropView = DropView {
-     _dropViewName :: [Char]
-}
+data DropView a = DropView
+    {
+      _dropViewName :: [Char]
+    } deriving (Show)
 
 -- Make the lenses.
 makeLenses ''DropTable