Refactoring
parent
8e74c20705
commit
b7d13c4947
98
src/Ringo.hs
98
src/Ringo.hs
|
@ -1,13 +1,15 @@
|
||||||
module Ringo where
|
module Ringo where
|
||||||
|
|
||||||
import Ringo.Types
|
import Ringo.Types
|
||||||
|
-- import qualified Ringo.Tables as Tables
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as Text
|
||||||
|
|
||||||
import Data.Maybe (mapMaybe, fromMaybe, fromJust)
|
import Data.Maybe (mapMaybe, fromMaybe, fromJust)
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
import Data.List (nub, find)
|
import Data.List (nub, find)
|
||||||
|
import Data.Text (Text)
|
||||||
|
|
||||||
data ValidationError = MissingTable TableName
|
data ValidationError = MissingTable TableName
|
||||||
| MissingFact TableName
|
| MissingFact TableName
|
||||||
|
@ -35,23 +37,22 @@ validateTable tables table = concatMap checkConstraint . tableConstraints $ tabl
|
||||||
checkConstraint (UniqueKey columnNames) = checkTableForColRefs table columnNames
|
checkConstraint (UniqueKey columnNames) = checkTableForColRefs table columnNames
|
||||||
checkConstraint (ForeignKey oTableName columnNames) =
|
checkConstraint (ForeignKey oTableName columnNames) =
|
||||||
case findTable oTableName tables of
|
case findTable oTableName tables of
|
||||||
Just oTable ->
|
Just oTable -> checkTableForColRefs table (map fst columnNames)
|
||||||
checkTableForColRefs table (map fst columnNames)
|
++ checkTableForColRefs oTable (map snd columnNames)
|
||||||
++ checkTableForColRefs oTable (map snd columnNames)
|
Nothing -> [ MissingTable oTableName ]
|
||||||
Nothing -> [MissingTable oTableName]
|
|
||||||
|
|
||||||
checkTableForColRefs tab = concatMap (checkTableForCol tab)
|
checkTableForColRefs tab = concatMap (checkTableForCol tab)
|
||||||
|
|
||||||
validateFact :: [Table] -> [Fact] -> Fact -> [ValidationError]
|
validateFact :: [Table] -> [Fact] -> Fact -> [ValidationError]
|
||||||
validateFact tables facts Fact {..} =
|
validateFact tables facts Fact {..} =
|
||||||
case findTable factTableName tables of
|
case findTable factTableName tables of
|
||||||
Nothing -> [MissingTable factTableName]
|
Nothing -> [ MissingTable factTableName ]
|
||||||
Just table -> validateTable tables table
|
Just table -> validateTable tables table
|
||||||
++ concatMap checkFactParents factParentNames
|
++ concatMap checkFactParents factParentNames
|
||||||
++ concatMap (checkColumn table) factColumns
|
++ concatMap (checkColumn table) factColumns
|
||||||
where
|
where
|
||||||
checkFactParents fName = case findFact fName facts of
|
checkFactParents fName = case findFact fName facts of
|
||||||
Nothing -> [MissingFact fName]
|
Nothing -> [ MissingFact fName ]
|
||||||
Just pFact -> validateFact tables facts pFact
|
Just pFact -> validateFact tables facts pFact
|
||||||
checkColumn table = maybe [] (checkTableForCol table) . factColumnName
|
checkColumn table = maybe [] (checkTableForCol table) . factColumnName
|
||||||
|
|
||||||
|
@ -62,15 +63,13 @@ withFactValidation tables facts fact func =
|
||||||
then Left errors
|
then Left errors
|
||||||
else Right . func . fromJust $ findTable (factTableName fact) tables
|
else Right . func . fromJust $ findTable (factTableName fact) tables
|
||||||
|
|
||||||
extractDimensions' :: [Table] -> T.Text -> Fact -> Table -> [Table]
|
extractDimensions' :: [Table] -> Text -> Fact -> Table -> [Table]
|
||||||
extractDimensions' tables prefix fact Table {..} = dimsFromIds ++ dimsFromVals
|
extractDimensions' tables prefix fact Table {..} = dimsFromIds ++ dimsFromVals
|
||||||
where
|
where
|
||||||
dimsFromIds =
|
dimsFromIds =
|
||||||
mapMaybe (\fcol -> case fcol of
|
flip mapMaybe (factColumns fact) $ \fcol -> case fcol of
|
||||||
DimId d _ -> findTable d tables
|
DimId d _ -> findTable d tables
|
||||||
_ -> Nothing)
|
_ -> Nothing
|
||||||
. factColumns
|
|
||||||
$ fact
|
|
||||||
|
|
||||||
dimsFromVals =
|
dimsFromVals =
|
||||||
map (\(dim, cols) -> Table { tableName = prefix <> dim
|
map (\(dim, cols) -> Table { tableName = prefix <> dim
|
||||||
|
@ -85,26 +84,22 @@ extractDimensions' tables prefix fact Table {..} = dimsFromIds ++ dimsFromVals
|
||||||
. mapMaybe (\fcol -> do
|
. mapMaybe (\fcol -> do
|
||||||
DimVal d col <- fcol
|
DimVal d col <- fcol
|
||||||
column <- findColumn col tableColumns
|
column <- findColumn col tableColumns
|
||||||
return (d, [column]))
|
return (d, [ column ]))
|
||||||
. map Just
|
. map Just
|
||||||
. factColumns
|
. factColumns
|
||||||
$ fact
|
$ fact
|
||||||
|
|
||||||
cleanColumn dim col@Column {..} =
|
cleanColumn dim col@Column {..} =
|
||||||
col { columnName = fromMaybe columnName . T.stripPrefix (T.snoc dim '_') $ columnName }
|
col { columnName = fromMaybe columnName . Text.stripPrefix (dim <> "_") $ columnName }
|
||||||
|
|
||||||
extractDimensions :: [Table] -> [Fact] -> T.Text -> Fact -> Either [ValidationError] [Table]
|
extractDimensions :: [Table] -> [Fact] -> Text -> Fact -> Either [ValidationError] [Table]
|
||||||
extractDimensions tables facts prefix fact =
|
extractDimensions tables facts prefix fact =
|
||||||
withFactValidation tables facts fact $ extractDimensions' tables prefix fact
|
withFactValidation tables facts fact $ extractDimensions' tables prefix fact
|
||||||
|
|
||||||
extractAllDimensions' :: [Table] -> [Fact] -> T.Text -> Fact -> Table -> [Table]
|
extractAllDimensions' :: [Table] -> [Fact] -> Text -> Fact -> Table -> [Table]
|
||||||
extractAllDimensions' tables facts dimPrefix fact table = nub go
|
extractAllDimensions' tables facts dimPrefix fact table =
|
||||||
|
nub $ extractDimensions' tables dimPrefix fact table ++ concatMap extract (factParentNames fact)
|
||||||
where
|
where
|
||||||
go = extractDimensions' tables dimPrefix fact table ++
|
|
||||||
if null $ factParentNames fact
|
|
||||||
then []
|
|
||||||
else concatMap extract . factParentNames $ fact
|
|
||||||
|
|
||||||
extract fName =
|
extract fName =
|
||||||
let pFact = fromJust . findFact fName $ facts
|
let pFact = fromJust . findFact fName $ facts
|
||||||
pFactTable = fromJust . findTable (factTableName pFact) $ tables
|
pFactTable = fromJust . findTable (factTableName pFact) $ tables
|
||||||
|
@ -112,34 +107,37 @@ extractAllDimensions' tables facts dimPrefix fact table = nub go
|
||||||
|
|
||||||
extractFactTable :: [Table] -> [Fact] -> Settings -> Fact -> Either [ValidationError] Table
|
extractFactTable :: [Table] -> [Fact] -> Settings -> Fact -> Either [ValidationError] Table
|
||||||
extractFactTable tables facts Settings {..} fact =
|
extractFactTable tables facts Settings {..} fact =
|
||||||
withFactValidation tables facts fact $ \table@Table{..} ->
|
withFactValidation tables facts fact $ \table ->
|
||||||
let allDims = extractAllDimensions' tables facts settingDimPrefix fact table
|
let intType = "integer"
|
||||||
sourceColumnType colName = columnType . fromJust $ findColumn colName tableColumns
|
allDims = extractAllDimensions' tables facts settingDimPrefix fact table
|
||||||
|
sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
|
||||||
|
|
||||||
columns = flip concatMap (factColumns fact) $ \col -> case col of
|
columns = flip concatMap (factColumns fact) $ \col -> case col of
|
||||||
DimTime cName -> [ Column (timeUnitColName cName) "integer" NotNull ]
|
DimTime cName -> [ Column (timeUnitColName cName) intType NotNull ]
|
||||||
NoDimId cName -> [ fromJust . findColumn cName $ tableColumns ]
|
NoDimId cName -> [ fromJust . findColumn cName . tableColumns $ table]
|
||||||
FactCount cName -> [ Column cName "integer" NotNull ]
|
FactCount cName -> [ Column cName intType NotNull ]
|
||||||
FactSum scName cName -> [ Column cName (sourceColumnType scName) NotNull ]
|
FactSum scName cName -> [ Column cName (sourceColumnType scName) NotNull ]
|
||||||
FactAverage scName cName -> [ Column (cName <> "_count") "integer" NotNull
|
FactAverage scName cName -> [ Column (cName <> "_count") intType NotNull
|
||||||
, Column (cName <> "_sum") (sourceColumnType scName) NotNull
|
, Column (cName <> "_sum") (sourceColumnType scName) NotNull
|
||||||
, Column cName "double" NotNull
|
|
||||||
]
|
]
|
||||||
FactCountDistinct cName -> [ Column cName ("integer[]") NotNull ]
|
FactCountDistinct cName -> [ Column (cName <> "_hll") (intType <> "[]") NotNull ]
|
||||||
_ -> []
|
_ -> []
|
||||||
fks = flip map allDims $ \Table { tableName = tName, tableColumns = tCols } ->
|
|
||||||
let colName = fromMaybe tName (T.stripPrefix settingDimPrefix tName) <> "_id"
|
fks = flip map allDims $ \Table { .. } ->
|
||||||
colNullable = if any ((== Null) . columnNullable) tCols then Null else NotNull
|
let colName = fromMaybe tableName (Text.stripPrefix settingDimPrefix tableName) <> "_id"
|
||||||
in (Column colName "integer" colNullable, ForeignKey tName [(colName, "id")])
|
colNullable = if any ((== Null) . columnNullable) tableColumns then Null else NotNull
|
||||||
ukColNames = mapMaybe (\col -> case col of
|
in (Column colName intType colNullable, ForeignKey tableName [(colName, "id")])
|
||||||
DimTime cName -> Just (timeUnitColName cName)
|
|
||||||
NoDimId cName -> Just cName
|
ukColNames =
|
||||||
_ -> Nothing) (factColumns fact)
|
(++ map (columnName . fst) fks)
|
||||||
++ map (columnName . fst) fks
|
. flip mapMaybe (factColumns fact) $ \col -> case col of
|
||||||
in Table { tableName = settingFactPrefix <> factName fact
|
DimTime cName -> Just (timeUnitColName cName)
|
||||||
, tableColumns = columns ++ map fst fks
|
NoDimId cName -> Just cName
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
in Table { tableName = settingFactPrefix <> factName fact
|
||||||
|
, tableColumns = columns ++ map fst fks
|
||||||
, tableConstraints = UniqueKey ukColNames : map snd fks
|
, tableConstraints = UniqueKey ukColNames : map snd fks
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
timeUnitColName colName = colName <> "_" <> timeUnitName settingTimeUnit <> "_id"
|
timeUnitColName colName = colName <> "_" <> timeUnitName settingTimeUnit <> "_id"
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue