From 048b19d4d21092921e8f741353d3ef9280a3770b Mon Sep 17 00:00:00 2001
From: Abhinav Sarkar <abhinav@abhinavsarkar.net>
Date: Thu, 10 Dec 2015 13:58:14 +0530
Subject: [PATCH] Adds table related types and some example tables.

---
 ringo.cabal        |  7 +++++++
 src/Ringo.hs       |  6 ++++--
 src/Ringo/Types.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 62 insertions(+), 2 deletions(-)
 create mode 100644 src/Ringo/Types.hs

diff --git a/ringo.cabal b/ringo.cabal
index e6e898c..8ceb9a1 100644
--- a/ringo.cabal
+++ b/ringo.cabal
@@ -17,6 +17,11 @@ library
   hs-source-dirs:      src
   exposed-modules:     Ringo
   build-depends:       base >= 4.7 && < 5
+                     , text
+                     , containers
+  default-extensions:  OverloadedStrings, RecordWildCards, ScopedTypeVariables,
+                       BangPatterns, TupleSections, NamedFieldPuns, GeneralizedNewtypeDeriving,
+                       DeriveDataTypeable
   default-language:    Haskell2010
 
 executable ringo
@@ -24,6 +29,8 @@ executable ringo
   main-is:             Main.hs
   build-depends:       base
                      , ringo
+                     , pretty-show
+  ghc-options:         -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans
   default-language:    Haskell2010
 
 test-suite ringo-test
diff --git a/src/Ringo.hs b/src/Ringo.hs
index 7d51c97..164d875 100644
--- a/src/Ringo.hs
+++ b/src/Ringo.hs
@@ -1,2 +1,4 @@
-module Ringo
-    () where
+module Ringo where
+
+import Ringo.Types
+import Ringo.Tables
diff --git a/src/Ringo/Types.hs b/src/Ringo/Types.hs
new file mode 100644
index 0000000..0912f90
--- /dev/null
+++ b/src/Ringo/Types.hs
@@ -0,0 +1,51 @@
+module Ringo.Types where
+
+import           Data.Text (Text)
+
+(&) :: a -> (a -> b) -> b
+x & f = f x
+
+type ColumnName = Text
+type ColumnType = Text
+type TableName = Text
+
+data Column = Column
+              { columnName     :: ColumnName
+              , columnType     :: ColumnType
+              , columnNullable :: Bool
+              , columnDefault  :: Maybe Text
+              } deriving (Eq, Show)
+
+data ColumnRef = ColumnRef ColumnName deriving (Eq, Show)
+
+data TableContraint = PrimaryKey ColumnRef
+                    | UniqueKey [ColumnRef]
+                    | ForeignKey TableRef [(ColumnRef, ColumnRef)]
+                    deriving (Eq, Show)
+
+data Table = Table
+             { tableName :: TableName
+             , tableColumns :: [Column]
+             , tableConstraints :: [TableContraint]
+             } deriving (Eq, Show)
+
+data TableRef = TableRef TableName deriving (Eq, Show)
+
+column :: ColumnName -> ColumnType -> Column
+column cname ctype = Column cname ctype True Nothing
+
+colNotNull :: Column -> Column
+colNotNull c = c { columnNullable = False }
+
+colDefault :: Text -> Column -> Column
+colDefault cdefault c = c { columnDefault = Just cdefault }
+
+primaryKey :: ColumnName -> TableContraint
+primaryKey = PrimaryKey . ColumnRef
+
+uniqueKey :: [ColumnName] -> TableContraint
+uniqueKey = UniqueKey . map ColumnRef
+
+foreignKey :: TableName -> [(ColumnName, ColumnName)] -> TableContraint
+foreignKey tableName =
+  ForeignKey (TableRef tableName) . map (\(c1, c2) -> (ColumnRef c1, ColumnRef c2))