Refactoring.

ringo.cabal

@@ -41,7 +41,7 @@ executable ringo
                        bytestring           >=0.10    && <0.11,
                        containers           >=0.5     && <0.6,
                        optparse-applicative >=0.11    && <0.12,
-                       yaml                 >=0.8  && <0.9,
+                       yaml                 >=0.8.11  && <0.9,
                        vector               >=0.10    && <0.11,
                        directory            >=1.2     && <1.3,
                        filepath             >=1.3     && <1.5,

src/Ringo/Extractor.hs

@@ -31,7 +31,7 @@ extractFactTable fact = do
       columns = concatFor (factColumns fact) $ \col -> case col of
         DimTime cName             ->
           [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
-        NoDimId cName             -> [ fromJust . findColumn cName . tableColumns $ table]
+        NoDimId cName             -> [ fromJust . findColumn cName . tableColumns $ table] -- TODO should be not null
         FactCount _ cName         -> [ Column cName countColType NotNull ]
         FactSum scName cName      -> [ Column cName (sourceColumnType scName) NotNull ]
         FactAverage scName cName  ->
@@ -41,13 +41,13 @@ extractFactTable fact = do
         FactCountDistinct _ cName -> [ Column cName "json" NotNull ]
         _                         -> []
 
-      fkCols = for allDims $ \(_, Table {..}) ->
+      fkColumns = for allDims $ \(_, Table {..}) ->
         let colName     = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
             colType     = idColTypeToFKIdColType settingDimTableIdColumnType
         in Column colName colType NotNull
 
       ukColNames =
-        (++ map columnName fkCols)
+        (++ map columnName fkColumns)
         . forMaybe (factColumns fact) $ \col -> case col of
             DimTime cName -> Just (timeUnitColumnName dimIdColName cName settingTimeUnit)
             NoDimId cName -> Just cName
@@ -56,7 +56,7 @@ extractFactTable fact = do
   return Table
          { tableName        =
              extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
-         , tableColumns     = columns ++ fkCols
+         , tableColumns     = columns ++ fkColumns
          , tableConstraints = [ UniqueKey ukColNames ]
          }
 

src/Ringo/Extractor/Internal.hs

@@ -80,6 +80,4 @@ extractAllDimensionTables fact = do
   parentDims <- concat <$> mapM extract (factParentNames fact)
   return . nubBy ((==) `on` snd) $ myDims ++ parentDims
   where
-    extract fName = do
+    extract fName = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName
-      facts <- asks envFacts
-      extractAllDimensionTables . fromJust . findFact fName $ facts

src/Ringo/Generator.hs

@@ -15,7 +15,7 @@ import Control.Applicative  ((<$>))
 
 import Control.Monad.Reader (Reader, asks)
 import Data.List            (nub, find)
-import Data.Maybe           (fromJust, fromMaybe, mapMaybe)
+import Data.Maybe           (fromJust, fromMaybe, mapMaybe, listToMaybe)
 import Data.Monoid          ((<>))
 import Data.Text            (Text)
 
@@ -23,13 +23,12 @@ import Ringo.Extractor.Internal
 import Ringo.Types
 import Ringo.Utils
 
-nullableDefnSQL :: Nullable -> Text
-nullableDefnSQL Null    = "NULL"
-nullableDefnSQL NotNull = "NOT NULL"
-
 columnDefnSQL :: Column -> Text
 columnDefnSQL Column {..} =
   columnName <> " " <> columnType <> " " <> nullableDefnSQL columnNullable
+  where
+    nullableDefnSQL Null    = "NULL"
+    nullableDefnSQL NotNull = "NOT NULL"
 
 joinColumnNames :: [ColumnName] -> Text
 joinColumnNames = Text.intercalate ",\n"
@@ -37,8 +36,15 @@ joinColumnNames = Text.intercalate ",\n"
 fullColName :: TableName -> ColumnName -> ColumnName
 fullColName tName cName = tName <> "." <> cName
 
-constraintDefnSQL :: Table -> TableConstraint -> [Text]
+tableDefnSQL :: Table -> [Text]
-constraintDefnSQL Table {..} constraint =
+tableDefnSQL Table {..} =
+  tableSQL : concatMap constraintDefnSQL tableConstraints
+  where
+    tableSQL = "CREATE TABLE " <> tableName <> " (\n"
+                 <> (joinColumnNames . map columnDefnSQL $ tableColumns)
+                 <> "\n)"
+
+    constraintDefnSQL constraint =
       let alterTableSQL = "ALTER TABLE ONLY " <> tableName <> " ADD "
       in case constraint of
         PrimaryKey cName -> [ alterTableSQL <> "PRIMARY KEY (" <> cName <> ")" ]
@@ -47,13 +53,6 @@ constraintDefnSQL Table {..} constraint =
               <> oTableName <> " (" <> joinColumnNames (map snd cNamePairs) <> ")" ]
         UniqueKey cNames -> ["CREATE UNIQUE INDEX ON " <> tableName <> " (" <> joinColumnNames cNames <> ")"]
 
-tableDefnSQL :: Table -> [Text]
-tableDefnSQL table@Table {..} =
-  tableSQL : concatMap (constraintDefnSQL table) tableConstraints
-  where
-    tableSQL = "CREATE TABLE " <> tableName <> " (\n"
-                 <> (joinColumnNames . map columnDefnSQL $ tableColumns)
-                 <> "\n)"
 
 factTableDefnSQL :: Fact -> Table -> Reader Env [Text]
 factTableDefnSQL fact table = do
@@ -100,14 +99,11 @@ dimensionTablePopulateSQL popMode fact dimTableName = do
   defaults            <- asks envTypeDefaults
   let factTable       = fromJust $ findTable (factTableName fact) tables
       colMapping      = dimColumnMapping dimPrefix fact dimTableName
-      baseSelectC     = "SELECT DISTINCT\n"
+      selectCols      = [ coalesceColumn defaults (factTableName fact) col <> " AS " <> cName
-                          <> joinColumnNames
+                          | (_, cName) <- colMapping
-                              (map (\(_, cName) ->
+                          , let col    = fromJust . findColumn cName $ tableColumns factTable ]
-                                     let col = fromJust . findColumn cName $ tableColumns factTable
+      baseSelectC     = "SELECT DISTINCT\n" <> joinColumnNames selectCols
-                                     in coalesceColumn defaults (factTableName fact) col <> " AS " <> cName)
+                          <> "\nFROM " <> factTableName fact
-                                   colMapping)
-                          <> "\n"
-                          <> "FROM " <> factTableName fact
       insertC selectC = "INSERT INTO " <> dimTableName
                           <> " (\n" <> joinColumnNames (map fst colMapping) <> "\n) "
                           <> "SELECT x.* FROM (\n" <> selectC <> ") x"
@@ -122,7 +118,7 @@ dimensionTablePopulateSQL popMode fact dimTableName = do
                  <> "\n)")
         <> "\nLEFT JOIN " <> dimTableName <> " ON\n"
         <> Text.intercalate " \nAND "
-              [ fullColName dimTableName c1 <> " IS NOT DISTINCT FROM " <> fullColName "x" c2
+              [ fullColName dimTableName c1 <> " IS NOT DISTINCT FROM " <> fullColName "x" c2 -- TODO can be replaced with = ?
                 | (c1, c2) <- colMapping ]
         <> "\nWHERE " <> Text.intercalate " \nAND "
                            [ fullColName dimTableName c <> " IS NULL" | (c, _) <- colMapping ]
@@ -135,6 +131,58 @@ data FactTablePopulateSelectSQL = FactTablePopulateSelectSQL
                                 , ftpsGroupByCols  :: ![Text]
                                 } deriving (Show, Eq)
 
+factTableUpdateSQL :: Fact -> Text -> FactTablePopulateSelectSQL -> Reader Env [Text]
+factTableUpdateSQL fact groupByColPrefix populateSelectSQL@FactTablePopulateSelectSQL {..} = do
+  Settings {..}         <- asks envSettings
+  tables                <- asks envTables
+  let countDistinctCols = [ col | col@(FactCountDistinct _ _) <- factColumns fact]
+      fTableName        = factTableName fact
+      fTable            = fromJust . findTable fTableName $ tables
+      tablePKColName    = head [ cName | PrimaryKey cName <- tableConstraints fTable ]
+      extFactTableName  =
+        extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
+
+  return $ for countDistinctCols $ \(FactCountDistinct scName cName) ->
+    let unqCol           = fullColName fTableName (fromMaybe tablePKColName scName) <> "::text"
+
+        bucketSelectCols =
+          [ ( "hashtext(" <> unqCol <> ") & "
+               <> Text.pack (show $ bucketCount settingFactCountDistinctErrorRate - 1)
+            , cName <> "_bnum"
+            )
+          , ( "31 - floor(log(2, min(hashtext(" <> unqCol <> ") & ~(1 << 31))))::int"
+            , cName <> "_bhash"
+            )
+          ]
+
+        selectSQL        = toSelectSQL $
+          populateSelectSQL
+            { ftpsSelectCols   = filter ((`elem` ftpsGroupByCols) . snd) ftpsSelectCols ++ bucketSelectCols
+            , ftpsGroupByCols  = ftpsGroupByCols ++ [ cName <> "_bnum" ]
+            , ftpsWhereClauses = ftpsWhereClauses ++ [ unqCol <> " IS NOT NULL" ]
+            }
+
+        aggSelectClause  =
+          "json_object_agg(" <> cName <> "_bnum, " <> cName <> "_bhash) AS " <> cName
+
+    in "UPDATE " <> extFactTableName
+         <> "\nSET " <> cName <> " = " <> fullColName "xyz" cName
+         <> "\nFROM ("
+         <> "\nSELECT " <> joinColumnNames (ftpsGroupByCols ++ [aggSelectClause])
+         <> "\nFROM (\n" <> selectSQL <> "\n) zyx"
+         <> "\nGROUP BY \n" <> joinColumnNames ftpsGroupByCols
+         <> "\n) xyz"
+         <> "\n WHERE\n"
+         <> Text.intercalate "\nAND "
+              [ fullColName extFactTableName .fromJust . Text.stripPrefix groupByColPrefix $ col
+                  <> " = " <> fullColName "xyz" col
+                | col <- ftpsGroupByCols ]
+  where
+    bucketCount :: Double -> Integer
+    bucketCount errorRate =
+      let power :: Double = fromIntegral (ceiling . logBase 2 $ (1.04 / errorRate) ** 2 :: Integer)
+      in ceiling $ 2 ** power
+
 factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text]
 factTablePopulateSQL popMode fact = do
   Settings {..}      <- asks envSettings
@@ -144,7 +192,6 @@ factTablePopulateSQL popMode fact = do
   let fTableName     = factTableName fact
       fTable         = fromJust . findTable fTableName $ tables
       dimIdColName   = settingDimTableIdColumnName
-      tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints fTable ]
 
       timeUnitColumnInsertSQL cName =
         let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
@@ -176,29 +223,27 @@ factTablePopulateSQL popMode fact = do
         FactCountDistinct _ cName -> [ (cName, "'{}'::json", False)]
         _                        -> []
 
-      dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) ->
+      dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let
-        let colName             = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
+          dimFKIdColName        = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
-            col                 = fromJust . findColumn colName $ tableColumns factSourceTable
           factSourceTableName   = factTableName dimFact
           factSourceTable       = fromJust . findTable factSourceTableName $ tables
-            insertSQL           = if factTable `elem` tables -- existing dimension table
+          dimFKIdColumn         = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable
-              then (if columnNullable col == Null then coalesceFKId else id)
-                     $ fullColName factSourceTableName colName
-              else let
           dimLookupWhereClauses =
-                    [ fullColName tableName c1 <> " = " <> coalesceColumn defaults factSourceTableName col2
+            [ fullColName tableName dimColName <> " = " <> coalesceColumn defaults factSourceTableName sourceCol
-                      | (c1, c2) <- dimColumnMapping settingDimPrefix dimFact tableName
+              | (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName
-                      , let col2 = fromJust . findColumn c2 $ tableColumns factSourceTable ]
+              , let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ]
-                in "SELECT " <> dimIdColName <> " FROM " <> tableName <> "\nWHERE "
+          insertSQL           = if factTable `elem` tables -- existing dimension table
+            then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id)
+                   $ fullColName factSourceTableName dimFKIdColName
+            else "SELECT " <> dimIdColName <> " FROM " <> tableName <> "\nWHERE "
                   <> Text.intercalate "\n AND " dimLookupWhereClauses
           insertSQL' = if factSourceTableName == fTableName
                          then insertSQL
-                           else coalesceFKId insertSQL
+                         else coalesceFKId insertSQL -- TODO always coalesce
+        in (dimFKIdColName, insertSQL', True)
 
-        in (colName, insertSQL', True)
+      colMap              = [ (cName, (sql, groupByColPrefix <> cName), addToGroupBy)
-
+                              | (cName, sql, addToGroupBy) <- factColMap ++ dimColMap ]
-      colMap = [ (cName, (sql, groupByColPrefix <> cName), addAs)
-                 | (cName, sql, addAs) <- factColMap ++ dimColMap ]
 
       joinClauses         =
         mapMaybe (\tName -> (\p -> "LEFT JOIN " <> tName <> "\nON "<> p) <$> joinClausePreds fTable tName)
@@ -211,7 +256,7 @@ factTablePopulateSQL popMode fact = do
       extFactTableName    =
         extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
 
-      insertIntoSelectSQL =
+      populateSelectSQL   =
         FactTablePopulateSelectSQL
           { ftpsSelectCols   = map snd3 colMap
           , ftpsSelectTable  = fTableName
@@ -222,66 +267,28 @@ factTablePopulateSQL popMode fact = do
           , ftpsGroupByCols  = map ((groupByColPrefix <>) . fst3) . filter thd3 $ colMap
           }
 
-      insertIntoInsertSQL = "INSERT INTO " <> extFactTableName
+      insertIntoSQL       = "INSERT INTO " <> extFactTableName
-                              <> " (\n" <> Text.intercalate ",\n " (map fst3 colMap) <> "\n)"
+                              <> " (\n" <> Text.intercalate ",\n " (map fst3 colMap) <> "\n)\n"
+                              <> toSelectSQL populateSelectSQL
 
-      countDistinctCols   = [ col | col@(FactCountDistinct _ _) <- factColumns fact]
+  updateSQLs <- factTableUpdateSQL fact groupByColPrefix populateSelectSQL
 
-      updateSQLs          =
+  return $ insertIntoSQL : updateSQLs
-        let origGroupByCols = ftpsGroupByCols insertIntoSelectSQL
-            origSelectCols  = ftpsSelectCols insertIntoSelectSQL
-
-        in for countDistinctCols $ \(FactCountDistinct scName cName) ->
-          let unqCol           = fullColName fTableName (fromMaybe tablePKColName scName) <> "::text"
-
-              bucketSelectCols =
-                [ ( "hashtext(" <> unqCol <> ") & "
-                     <> Text.pack (show $ bucketCount settingFactCountDistinctErrorRate - 1)
-                  , cName <> "_bnum")
-                , ( "31 - floor(log(2, min(hashtext(" <> unqCol <> ") & ~(1 << 31))))::int"
-                  , cName <> "_bhash"
-                  )
-                ]
-
-              selectSQL        = toSelectSQL $
-                insertIntoSelectSQL
-                  { ftpsSelectCols   = filter ((`elem` origGroupByCols) . snd) origSelectCols ++ bucketSelectCols
-                  , ftpsGroupByCols  = origGroupByCols ++ [cName <> "_bnum"]
-                  , ftpsWhereClauses = ftpsWhereClauses insertIntoSelectSQL ++ [ unqCol <> " IS NOT NULL" ]
-                  }
-
-              aggSelectClause  =
-                "json_object_agg(" <> cName <> "_bnum, " <> cName <> "_bhash) AS " <> cName
-
-          in "UPDATE " <> extFactTableName
-               <> "\nSET " <> cName <> " = " <> fullColName "xyz" cName
-               <> "\nFROM ("
-               <> "\nSELECT " <> joinColumnNames (origGroupByCols ++ [aggSelectClause])
-               <> "\nFROM (\n" <> selectSQL <> "\n) zyx"
-               <> "\nGROUP BY \n" <> joinColumnNames origGroupByCols
-               <> "\n) xyz"
-               <> "\n WHERE\n"
-               <> Text.intercalate "\nAND "
-                    [ fullColName extFactTableName .fromJust . Text.stripPrefix groupByColPrefix $ col
-                        <> " = " <> fullColName "xyz" col
-                      | col <- origGroupByCols ]
-
-  return $ insertIntoInsertSQL <> "\n" <> toSelectSQL insertIntoSelectSQL :
-             if null countDistinctCols then [] else updateSQLs
   where
     groupByColPrefix = "xxff_"
 
     joinClausePreds table oTableName =
-      fmap (\(ForeignKey _ colPairs) ->
       Text.intercalate " AND "
       . map (\(c1, c2) -> fullColName (tableName table) c1 <> " = " <> fullColName oTableName c2)
-              $ colPairs )
+      <$> listToMaybe [ colPairs | ForeignKey tName colPairs <-  tableConstraints table
-      . find (\cons -> case cons of
+                                 , tName == oTableName ]
-                  ForeignKey tName _ -> tName == oTableName
-                  _                  -> False)
-      . tableConstraints
-      $ table
 
+    coalesceFKId col =
+      if "coalesce" `Text.isPrefixOf` col
+        then col
+        else "coalesce((" <> col <> "), -1)"
+
+toSelectSQL :: FactTablePopulateSelectSQL -> Text
 toSelectSQL FactTablePopulateSelectSQL {..} =
   "SELECT \n" <> joinColumnNames (map (uncurry asName) ftpsSelectCols)
     <> "\nFROM " <> ftpsSelectTable
@@ -296,13 +303,3 @@ factTablePopulateSQL popMode fact = do
   where
     asName sql alias = "(" <> sql <> ")" <> " as " <> alias
 
-    coalesceFKId col =
-      if "coalesce" `Text.isPrefixOf` col
-        then col
-        else "coalesce((" <> col <> "), -1)"
-
-    bucketCount :: Double -> Integer
-    bucketCount errorRate =
-      let power :: Double = fromIntegral (ceiling . logBase 2 $ (1.04 / errorRate) ** 2 :: Integer)
-      in ceiling $ 2 ** power
-

src/Ringo/Validator.hs

@@ -29,7 +29,7 @@ validateTable table = do
   let constVs       = concatMap (checkConstraint tables) . tableConstraints $ table
       typeDefaultVs = [ MissingTypeDefault cType
                         | Column _ cType _ <- tableColumns table
-                        , null . filter (`Text.isPrefixOf` cType) $ defaults]
+                        , null . filter (`Text.isPrefixOf` cType) $ defaults] -- TODO only dimval columns need this check
   return $ constVs ++ typeDefaultVs
   where
     checkConstraint _ (PrimaryKey colName)    = checkTableForCol table colName