Adds support for tenant id fact column for multi-tenant databse designs.

app/Ringo/InputParser.hs

@@ -52,6 +52,7 @@ instance FromJSON FactColumn where
     case cType of
       "dimtime"           -> DimTime           <$> o .: "column"
       "nodimid"           -> NoDimId           <$> o .: "column"
+      "tenantid"          -> TenantId          <$> o .: "column"
       "dimid"             -> DimId             <$> o .: "table"         <*> o .: "column"
       "dimval"            -> DimVal            <$> o .: "table"         <*> o .: "column"
       "factcount"         -> FactCount         <$> o .:? "sourcecolumn" <*> o .: "column"

src/Ringo/Extractor.hs

@@ -24,21 +24,22 @@ extractFactTable fact = do
   tables        <- asks envTables
   let table     =  fromJust . findTable (factTableName fact) $ tables
 
-  let countColType             = settingFactCountColumnType
-      dimIdColName             = settingDimTableIdColumnName
-      sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
+  let countColType              = settingFactCountColumnType
+      dimIdColName              = settingDimTableIdColumnName
+      sourceColumn cName        = fromJust . findColumn cName . tableColumns $ table
+      notNullSourceColumnCopy cName          = (sourceColumn cName) { columnNullable = NotNull }
+      notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
 
       columns = concatFor (factColumns fact) $ \col -> case col of
         DimTime cName             ->
           [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
-        NoDimId cName             -> let
-            col' = fromJust . findColumn cName . tableColumns $ table
-          in [ col' { columnNullable = NotNull } ]
+        NoDimId cName             -> [ notNullSourceColumnCopy cName ]
+        TenantId cName            -> [ notNullSourceColumnCopy cName ]
         FactCount _ cName         -> [ Column cName countColType NotNull ]
-        FactSum scName cName      -> [ Column cName (sourceColumnType scName) NotNull ]
+        FactSum scName cName      -> [ notNullSourceColumnRename scName cName ]
         FactAverage scName cName  ->
           [ Column (cName <> settingAvgCountColumSuffix) countColType NotNull
-          , Column (cName <> settingAvgSumColumnSuffix) (sourceColumnType scName) NotNull
+          , notNullSourceColumnRename scName (cName <> settingAvgSumColumnSuffix)
           ]
         FactCountDistinct _ cName -> [ Column cName "json" NotNull ]
         _                         -> []
@@ -51,9 +52,10 @@ extractFactTable fact = do
       ukColNames =
         (++ map columnName fkColumns)
         . forMaybe (factColumns fact) $ \col -> case col of
-            DimTime cName -> Just (timeUnitColumnName dimIdColName cName settingTimeUnit)
-            NoDimId cName -> Just cName
-            _             -> Nothing
+            DimTime cName  -> Just (timeUnitColumnName dimIdColName cName settingTimeUnit)
+            NoDimId cName  -> Just cName
+            TenantId cName -> Just cName
+            _              -> Nothing
 
   return Table
          { tableName        =

src/Ringo/Generator/Create.hs

@@ -6,6 +6,7 @@ import Control.Applicative  ((<$>))
 #endif
 
 import Control.Monad.Reader (Reader, asks)
+import Data.Maybe           (listToMaybe, maybeToList)
 import Data.Monoid          ((<>))
 import Data.Text            (Text)
 
@@ -17,7 +18,7 @@ import Ringo.Utils
 tableDefnSQL :: Table -> Reader Env [Text]
 tableDefnSQL Table {..} = do
   Settings {..} <- asks envSettings
-  let tabName = tableName <> settingTableNameSuffixTemplate
+  let tabName  = tableName <> settingTableNameSuffixTemplate
 
       tableSQL = "CREATE TABLE " <> tabName <> " (\n"
                    <> (joinColumnNames . map columnDefnSQL $ tableColumns)
@@ -55,16 +56,23 @@ factTableDefnSQL fact table = do
   Settings {..} <- asks envSettings
   allDims       <- extractAllDimensionTables fact
 
-  let factCols  = forMaybe (factColumns fact) $ \col -> case col of
-        DimTime cName -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
-        NoDimId cName -> Just cName
-        _             -> Nothing
+  let dimTimeCol           = head [ cName | DimTime cName <- factColumns fact ]
+      tenantIdCol          = listToMaybe [ cName | TenantId cName <- factColumns fact ]
+
+      dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
+
+      factCols  = forMaybe (factColumns fact) $ \col -> case col of
+        DimTime cName  -> Just $ dimTimeColName cName
+        NoDimId cName  -> Just cName
+        TenantId cName -> Just cName
+        _              -> Nothing
 
       dimCols   = [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName tableName
                     | (_, Table {..}) <- allDims ]
 
       indexSQLs = [ "CREATE INDEX ON " <> tableName table <> settingTableNameSuffixTemplate
                       <> " USING btree (" <> col <> ")"
-                    | col <- factCols ++ dimCols ]
+                    | col <- factCols ++ dimCols  ++ [ cName <> ", " <> dimTimeColName dimTimeCol
+                                                       | cName <- maybeToList tenantIdCol ] ]
 
   (++ indexSQLs) <$> tableDefnSQL table

src/Ringo/Generator/Populate/Fact.hs

@@ -129,12 +129,14 @@ factTablePopulateSQL popMode fact = do
                 <> Text.pack (show $ timeUnitToSeconds settingTimeUnit)
            , True
            )
+      dimIdColumnInsertSQL cName =
+        let sCol = fromJust . findColumn cName $ tableColumns fTable
+        in (cName, coalesceColumn defaults fTableName sCol, True)
 
       factColMap = concatFor (factColumns fact) $ \col -> case col of
         DimTime cName             -> [ timeUnitColumnInsertSQL cName ]
-        NoDimId cName             ->
-          let sCol = fromJust . findColumn cName $ tableColumns fTable
-          in [ (cName, coalesceColumn defaults fTableName sCol, True) ]
+        NoDimId cName             -> [ dimIdColumnInsertSQL cName ]
+        TenantId cName            -> [ dimIdColumnInsertSQL cName ]
         FactCount scName cName    ->
           [ (cName, "count(" <> maybe "*" (fullColumnName fTableName) scName <> ")", False) ]
         FactSum scName cName      ->

src/Ringo/Types.hs

@@ -50,6 +50,7 @@ data Fact = Fact
 
 data FactColumn = DimTime           !ColumnName
                 | NoDimId           !ColumnName
+                | TenantId          !ColumnName
                 | DimId             !TableName          !ColumnName
                 | DimVal            !TableName          !ColumnName
                 | FactCount         !(Maybe ColumnName) !ColumnName
@@ -61,6 +62,7 @@ data FactColumn = DimTime           !ColumnName
 factSourceColumnName :: FactColumn -> Maybe ColumnName
 factSourceColumnName (DimTime cName)             = Just cName
 factSourceColumnName (NoDimId cName)             = Just cName
+factSourceColumnName (TenantId cName)            = Just cName
 factSourceColumnName (DimId _ cName)             = Just cName
 factSourceColumnName (DimVal _ cName)            = Just cName
 factSourceColumnName (FactCount cName _)         = cName

src/Ringo/Validator.hs

@@ -56,7 +56,9 @@ validateFact Fact {..} = do
                             , columnNullable (fromJust col) == Null ]
           typeDefaultVs =
             [ MissingTypeDefault cType
-              | cName   <- [ c | DimVal _ c <- factColumns ] ++ [ c | NoDimId c <- factColumns ]
+              | cName   <- [ c | DimVal _ c <- factColumns ]
+                             ++ [ c | NoDimId c <- factColumns ]
+                             ++ [ c | TenantId c <- factColumns ]
               , let col = findColumn cName (tableColumns table)
               , isJust col
               , let cType = columnType $ fromJust col