Fixes bugs in fact table DDL and insert SQL generation.
This commit is contained in:
parent
4a07d0c828
commit
f8a6382aa3
@ -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 =
|
||||
|
@ -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) ->
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user