Refactoring.

pull/1/head
Abhinav Sarkar 7 years ago
parent a84325cb2a
commit c430e5f255
  1. 27
      src/Ringo/Extractor.hs
  2. 7
      src/Ringo/Extractor/Internal.hs
  3. 39
      src/Ringo/Generator.hs
  4. 17
      src/Ringo/Utils.hs
  5. 8
      src/Ringo/Validator.hs

@ -5,7 +5,7 @@ module Ringo.Extractor
) where
import Control.Monad.Reader (Reader, asks)
import Data.Maybe (mapMaybe, fromJust)
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Ringo.Extractor.Internal
@ -22,8 +22,9 @@ extractFactTable fact = do
dimIdColName = settingDimTableIdColumnName
sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
columns = flip concatMap (factColumns fact) $ \col -> case col of
DimTime cName -> [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "integer" NotNull ]
columns = concatFor (factColumns fact) $ \col -> case col of
DimTime cName ->
[ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "integer" NotNull ]
NoDimId cName -> [ fromJust . findColumn cName . tableColumns $ table]
FactCount cName -> [ Column cName countColType NotNull ]
FactSum scName cName -> [ Column cName (sourceColumnType scName) NotNull ]
@ -35,22 +36,22 @@ extractFactTable fact = do
[ Column (cName <> settingCountDistinctColumSuffix) (countColType <> "[]") NotNull ]
_ -> []
fks = flip map allDims $ \(_, Table {..}) ->
fks = for allDims $ \(_, Table {..}) ->
let colName = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
colType = idColTypeToFKIdColType settingDimTableIdColumnType
colNullable = if any ((== Null) . columnNullable) tableColumns then Null else NotNull
in ( Column colName (idColTypeToFKIdColType settingDimTableIdColumnType) colNullable
, ForeignKey tableName [(colName, dimIdColName)]
)
in ( Column colName colType colNullable , ForeignKey tableName [(colName, dimIdColName)] )
ukColNames =
(++ map (columnName . fst) fks)
. flip mapMaybe (factColumns fact) $ \col -> case col of
. forMaybe (factColumns fact) $ \col -> case col of
DimTime cName -> Just (timeUnitColumnName dimIdColName cName settingTimeUnit)
NoDimId cName -> Just cName
_ -> Nothing
return Table { tableName =
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
, tableColumns = columns ++ map fst fks
, tableConstraints = UniqueKey ukColNames : map snd fks
}
return Table
{ tableName =
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
, tableColumns = columns ++ map fst fks
, tableConstraints = UniqueKey ukColNames : map snd fks
}

@ -49,7 +49,7 @@ extractDimensionTables fact = do
return $ dimsFromIds tables ++ dimsFromVals settings (tableColumns table)
where
dimsFromIds tables =
flip mapMaybe (factColumns fact) $ \fcol -> case fcol of
forMaybe (factColumns fact) $ \fcol -> case fcol of
DimId d _ -> findTable d tables
_ -> Nothing
@ -63,9 +63,8 @@ extractDimensionTables fact = do
]
})
. Map.toList
. Map.mapWithKey (\dim ->
map (\col@Column {..} -> col { columnName = dimColumnName dim columnName })
. nub)
. Map.mapWithKey
(\dim -> map (\col -> col { columnName = dimColumnName dim (columnName col) }) . nub)
. Map.fromListWith (flip (++))
. mapMaybe (\fcol -> do
DimVal d col <- fcol

@ -56,21 +56,22 @@ factTableDefnSQL fact table = do
Settings {..} <- asks envSettings
allDims <- extractAllDimensionTables fact
let factCols = flip mapMaybe (factColumns fact) $ \col -> case col of
let factCols = forMaybe (factColumns fact) $ \col -> case col of
DimTime cName -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
NoDimId cName -> Just cName
_ -> Nothing
dimCols = flip map allDims $ \(_, Table {..}) ->
factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName tableName
dimCols = [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName tableName
| (_, Table {..}) <- allDims ]
indexSQLs = [ "CREATE INDEX ON " <> tableName table <> " USING btree (" <> col <> ")"
| col <- factCols ++ dimCols ]
indexSQLs = flip map (factCols ++ dimCols) $ \col ->
"CREATE INDEX ON " <> tableName table <> " USING btree (" <> col <> ")"
return $ tableDefnSQL table ++ indexSQLs
dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)]
dimColumnMapping dimPrefix fact dimTableName =
flip mapMaybe (factColumns fact) $ \fCol -> case fCol of
forMaybe (factColumns fact) $ \fCol -> case fCol of
DimVal dName cName | dimPrefix <> dName == dimTableName ->
Just (dimColumnName dName cName, cName)
_ -> Nothing
@ -88,19 +89,19 @@ dimensionTableInsertSQL fact dimTableName = do
factTableInsertSQL :: Fact -> Reader Env Text
factTableInsertSQL fact = do
let fTableName = factTableName fact
Settings {..} <- asks envSettings
allDims <- extractAllDimensionTables fact
tables <- asks envTables
let table = fromJust . findTable fTableName $ tables
let fTableName = factTableName fact
table = fromJust . findTable fTableName $ tables
dimIdColName = settingDimTableIdColumnName
let timeUnitColumnInsertSQL cName =
timeUnitColumnInsertSQL cName =
let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
in (colName, "floor(extract(epoch from " <> fullColName fTableName cName <> ")/"
<> Text.pack (show $ timeUnitToSeconds settingTimeUnit) <> ")")
factColMap = flip concatMap (factColumns fact) $ \col -> case col of
factColMap = concatFor (factColumns fact) $ \col -> case col of
DimTime cName -> [ timeUnitColumnInsertSQL cName ]
NoDimId cName -> [ (cName, fullColName fTableName cName) ]
FactCount cName -> [ (cName, "count(*)") ]
@ -111,22 +112,20 @@ factTableInsertSQL fact = do
, "sum(" <> fullColName fTableName scName <> ")") ]
_ -> []
dimColMap = flip map allDims $ \(dimFact, factTable@Table {..}) ->
dimColMap = for allDims $ \(dimFact, factTable@Table {..}) ->
let colName = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
factSourceTableName = factTableName dimFact
insertSQL =
if factTable `elem` tables
then fullColName factSourceTableName colName
else
let dimLookupWhereClauses =
map (\(c1, c2) ->
fullColName tableName c1 <> " = " <> fullColName factSourceTableName c2)
$ dimColumnMapping settingDimPrefix dimFact tableName
insertSQL = if factTable `elem` tables
then fullColName factSourceTableName colName
else let
dimLookupWhereClauses =
[ fullColName tableName c1 <> " = " <> fullColName factSourceTableName c2
| (c1, c2) <- dimColumnMapping settingDimPrefix dimFact tableName ]
in "SELECT " <> dimIdColName <> " FROM " <> tableName <> "\nWHERE "
<> (Text.concat . intersperse "\n AND " $ dimLookupWhereClauses)
in (colName, insertSQL)
colMap = map (\(cName, sql) -> (cName, asName cName sql)) $ factColMap ++ dimColMap
colMap = [ (cName, asName cName sql) | (cName, sql) <- factColMap ++ dimColMap ]
joinClauses =
mapMaybe (\tName -> (\p -> "LEFT JOIN " <> tName <> " ON "<> p) <$> joinClausePreds table tName)

@ -1,6 +1,7 @@
module Ringo.Utils where
import Data.List (find)
import Data.Maybe (mapMaybe)
import Data.List (find)
import Ringo.Types
@ -12,3 +13,17 @@ findFact fName = find ((== fName) . factName)
findColumn :: ColumnName -> [Column] -> Maybe Column
findColumn cName = find ((== cName) . columnName)
for :: [a] -> (a -> b) -> [b]
for = flip map
forMaybe :: [a] -> (a -> Maybe b) -> [b]
forMaybe = flip mapMaybe
#if MIN_VERSION_base(4,8,0)
concatFor :: (Foldable t) => t a -> (a -> [b]) -> [b]
concatFor = flip concatMap
#else
concatFor :: [a] -> (a -> [b]) -> [b]
concatFor = flip concatMap
#endif

@ -46,7 +46,7 @@ validateFact Fact {..} = do
return $ tableVs ++ parentVs ++ colVs
where
checkFactParents fName = do
facts <- asks envFacts
facts <- asks envFacts
case findFact fName facts of
Nothing -> return [ MissingFact fName ]
Just pFact -> validateFact pFact
@ -56,12 +56,8 @@ validateFact Fact {..} = do
++ checkColumnTable tables factCol
checkColumnTable tables factCol = case factCol of
DimId tName _ -> go tName
DimId tName _ -> maybe [ MissingTable tName ] (const []) $ findTable tName tables
_ -> []
where
go tName = case findTable tName tables of
Nothing -> [ MissingTable tName ]
Just _ -> []
withFactValidation :: Fact -> Reader Env a -> Reader Env (Either [ValidationError] a)
withFactValidation fact func = do

Loading…
Cancel
Save