Fixes bugs in fact table DDL and insert SQL generation.

src/Ringo/Extractor.hs

@@ -16,7 +16,8 @@ extractFactTable ::  Fact -> Reader Env Table
 extractFactTable fact = do
   Settings {..} <- asks envSettings
   allDims       <- extractAllDimensionTables fact
-  table         <- asks $ fromJust . findTable (factTableName fact) . envTables
+  tables        <- asks envTables
+  let table     =  fromJust . findTable (factTableName fact) $ tables
 
   let countColType             = settingFactCountColumnType
       dimIdColName             = settingDimTableIdColumnName
@@ -36,10 +37,13 @@ extractFactTable fact = do
           [ Column (cName <> settingCountDistinctColumSuffix) (countColType <> "[]") NotNull ]
         _                        -> []
 
-      fks = for allDims $ \(_, Table {..}) ->
+      fks = for allDims $ \(fact', tab@Table {..}) ->
         let colName     = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
             colType     = idColTypeToFKIdColType settingDimTableIdColumnType
-            colNullable = if any ((== Null) . columnNullable) tableColumns then Null else NotNull
+            colNullable =
+              if tab `elem` tables || fact /= fact' || any ((== Null) . columnNullable) tableColumns
+                then Null
+                else NotNull
         in ( Column colName colType colNullable , ForeignKey tableName [(colName, dimIdColName)] )
 
       ukColNames =

src/Ringo/Generator.hs

@@ -98,18 +98,27 @@ factTableInsertSQL fact = do
 
       timeUnitColumnInsertSQL cName =
         let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
-        in (colName, "floor(extract(epoch from " <> fullColName fTableName cName <> ")/"
-                        <> Text.pack (show $ timeUnitToSeconds settingTimeUnit) <> ")")
+        in ( colName
+           , "floor(extract(epoch from " <> fullColName fTableName cName <> ")/"
+                <> Text.pack (show $ timeUnitToSeconds settingTimeUnit) <> ")"
+           , True
+           )
 
       factColMap = concatFor (factColumns fact) $ \col -> case col of
         DimTime cName            -> [ timeUnitColumnInsertSQL cName ]
-        NoDimId cName            -> [ (cName, fullColName fTableName cName) ]
-        FactCount cName          -> [ (cName, "count(*)") ]
-        FactSum scName cName     -> [ (cName, "sum(" <> fullColName fTableName scName <> ")") ]
-        FactAverage scName cName -> [ ( cName <> settingAvgCountColumSuffix
-                                      , "count(" <> fullColName fTableName scName <> ")")
-                                    , ( cName <> settingAvgSumColumnSuffix
-                                      , "sum(" <> fullColName fTableName scName <> ")") ]
+        NoDimId cName            -> [ (cName, fullColName fTableName cName, True) ]
+        FactCount cName          -> [ (cName, "count(*)", False) ]
+        FactSum scName cName     -> [ (cName, "sum(" <> fullColName fTableName scName <> ")", False) ]
+        FactAverage scName cName ->
+          [ ( cName <> settingAvgCountColumSuffix
+            , "count(" <> fullColName fTableName scName <> ")"
+            , False
+            )
+          , ( cName <> settingAvgSumColumnSuffix
+            , "sum(" <> fullColName fTableName scName <> ")"
+            , False
+            )
+          ]
         _                        -> []
 
       dimColMap = for allDims $ \(dimFact, factTable@Table {..}) ->
@@ -123,26 +132,29 @@ factTableInsertSQL fact = do
                       | (c1, c2) <- dimColumnMapping settingDimPrefix dimFact tableName ]
                 in "SELECT " <> dimIdColName <> " FROM " <> tableName <> "\nWHERE "
                      <> (Text.concat . intersperse "\n AND " $ dimLookupWhereClauses)
-        in (colName, insertSQL)
+        in (colName, insertSQL, True)
 
-      colMap = [ (cName, asName cName sql) | (cName, sql) <- factColMap ++ dimColMap ]
+      colMap = [ (cName, if addAs then asName cName sql else sql, addAs)
+                 | (cName, sql, addAs) <- factColMap ++ dimColMap ]
 
       joinClauses =
         mapMaybe (\tName -> (\p -> "LEFT JOIN " <> tName <> " ON "<> p) <$> joinClausePreds table tName)
         . nub
-        . map (\(dimFact, _) -> factTableName dimFact)
+        . map (factTableName . fst)
         $ allDims
 
   return $ "INSERT INTO "
              <> extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
-             <> " (\n" <> Text.concat (intersperse ",\n " . map fst $ colMap) <> "\n)"
-             <> "\nSELECT \n" <> Text.concat (intersperse ",\n " . map snd $ colMap)
+             <> " (\n" <> unlineCols (map fst3 colMap) <> "\n)"
+             <> "\nSELECT \n" <> unlineCols (map snd3 colMap)
              <> "\nFROM " <> fTableName <> "\n" <> Text.concat (intersperse "\n" joinClauses)
-             <> "\nGROUP BY \n" <> Text.concat (intersperse ",\n " . map fst $ colMap)
+             <> "\nGROUP BY \n"
+             <> unlineCols (map ((groupByColPrefix <>) . fst3) . filter thd3 $ colMap)
   where
+    groupByColPrefix        = "xxff_"
     fullColName tName cName = tName <> "." <> cName
-
-    asName cName sql = "(" <> sql <> ")" <> " as " <> cName
+    asName cName sql        = "(" <> sql <> ")" <> " as " <> groupByColPrefix <> cName
+    unlineCols              = Text.concat . intersperse ",\n "
 
     joinClausePreds table oTableName =
       fmap (\(ForeignKey _ colPairs) ->

src/Ringo/Utils.hs

@@ -1,5 +1,7 @@
 module Ringo.Utils where
 
+import qualified Control.Arrow as Arrow
+
 import Data.Maybe (mapMaybe)
 import Data.List  (find)
 
@@ -27,3 +29,32 @@ concatFor = flip concatMap
 concatFor :: [a] -> (a -> [b]) -> [b]
 concatFor = flip concatMap
 #endif
+
+infixr 3 ***, &&&
+
+first :: (a -> a') -> (a, b) -> (a', b)
+first = Arrow.first
+
+second :: (b -> b') -> (a, b) -> (a, b')
+second = Arrow.second
+
+(***) :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
+(***) = (Arrow.***)
+
+(&&&) :: (a -> b) -> (a -> c) -> a -> (b, c)
+(&&&) = (Arrow.&&&)
+
+dupe :: a -> (a,a)
+dupe x = (x, x)
+
+both :: (a -> b) -> (a, a) -> (b, b)
+both f (x, y) = (f x, f y)
+
+fst3 :: (a, b, c) -> a
+fst3 (a, _, _) = a
+
+snd3 :: (a, b, c) -> b
+snd3 (_, b, _) = b
+
+thd3 :: (a, b, c) -> c
+thd3 (_, _, c) = c