Adds validation and dimension extraction functions.

src/Ringo.hs

@@ -1,4 +1,69 @@
 module Ringo where
 
 import Ringo.Types
-import Ringo.Tables
+
+import qualified Data.Map as Map
+import Data.Maybe (mapMaybe, fromMaybe)
+import Data.List (nub)
+import qualified Data.Text as T
+
+data ValidationError = MissingTable TableName
+                     | MissingColumn TableName ColumnName
+                     deriving (Eq, Show)
+
+indexList :: Ord k => (a -> k) -> [a] -> Map.Map k a
+indexList f = Map.fromList . map (\x -> (f x, x))
+
+checkTableForCol :: Table -> ColumnName -> [ValidationError]
+checkTableForCol tab colName =
+  [MissingColumn (tableName tab) colName |
+    not . any ((colName ==) . columnName) . tableColumns $ tab]
+
+validateTable :: [Table] -> Table -> [ValidationError]
+validateTable tables table = concatMap checkConstraint . tableConstraints $ table
+  where
+    tableMap = indexList tableName tables
+
+    checkConstraint (PrimaryKey colName)    = checkTableForCol table colName
+    checkConstraint (UniqueKey columnNames) = checkTableForColRefs table columnNames
+    checkConstraint (ForeignKey oTableName columnNames) =
+      case Map.lookup oTableName tableMap of
+        Just oTable ->
+          checkTableForColRefs table (map fst columnNames)
+          ++ checkTableForColRefs oTable (map snd columnNames)
+        Nothing     -> [MissingTable oTableName]
+
+    checkTableForColRefs tab = concatMap (checkTableForCol tab)
+
+validateFact :: [Table] -> Fact -> [ValidationError]
+validateFact tables Fact {..} =
+  case Map.lookup factTableName tableMap of
+    Nothing    -> [MissingTable factTableName]
+    Just table -> concatMap (checkColumn table) factColumns
+  where
+    tableMap = indexList tableName tables
+
+    checkColumn table = checkTableForCol table . factColumnName
+
+extractDimensions :: T.Text -> Table -> Fact -> [Table]
+extractDimensions prefix Table {..} Fact {..} =
+  map (\(dim, cols) -> Table { tableName        = T.concat [prefix, dim]
+                             , tableColumns     = Column "id" "serial" NotNullable : cols
+                             , tableConstraints = [ PrimaryKey "id"
+                                                  , UniqueKey (map columnName cols)
+                                                  ]
+                             })
+  . Map.toList
+  . Map.mapWithKey (\dim -> map (cleanColumn dim) . nub)
+  . Map.fromListWith (++)
+  . mapMaybe (\fcol -> do
+                DimVal d col <- fcol
+                column       <- Map.lookup col columnMap
+                return (d, [column]))
+  . map Just
+  $ factColumns
+  where
+    columnMap = indexList columnName tableColumns
+
+    cleanColumn dim col@Column {..} =
+      col { columnName = fromMaybe columnName . T.stripPrefix (T.snoc dim '_') $ columnName }

src/Ringo/Types.hs

@@ -9,43 +9,42 @@ type ColumnName = Text
 type ColumnType = Text
 type TableName = Text
 
+data Nullable = Nullable | NotNullable deriving (Eq, Enum, Show)
+
 data Column = Column
-              { columnName     :: ColumnName
-              , columnType     :: ColumnType
-              , columnNullable :: Bool
-              , columnDefault  :: Maybe Text
+              { columnName        :: ColumnName
+              , columnType        :: ColumnType
+              , columnNullable    :: Nullable
               } deriving (Eq, Show)
 
-data ColumnRef = ColumnRef ColumnName deriving (Eq, Show)
-
-data TableContraint = PrimaryKey ColumnRef
-                    | UniqueKey [ColumnRef]
-                    | ForeignKey TableRef [(ColumnRef, ColumnRef)]
+data TableContraint = PrimaryKey ColumnName
+                    | UniqueKey [ColumnName]
+                    | ForeignKey TableName [(ColumnName, ColumnName)]
                     deriving (Eq, Show)
 
 data Table = Table
-             { tableName :: TableName
-             , tableColumns :: [Column]
+             { 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))
+data TimeUnit = Second | Minute | Hour | Day | Week | Month | Year
+                deriving (Eq, Enum, Show)
+
+data Fact = Fact
+            { factName      :: TableName
+            , factTableName :: TableName
+            , factColumns   :: [FactColumn]
+            } deriving (Eq, Show)
+
+data FactColumn = DimTime ColumnName
+                | NoDimId ColumnName
+                | DimId TableName ColumnName
+                | DimVal TableName ColumnName
+                deriving (Eq, Show)
+
+factColumnName :: FactColumn -> ColumnName
+factColumnName (DimTime cName)  = cName
+factColumnName (NoDimId cName)  = cName
+factColumnName (DimId _ cName)  = cName
+factColumnName (DimVal _ cName) = cName