diff --git a/src/Ringo.hs b/src/Ringo.hs index 957acca..33070db 100644 --- a/src/Ringo.hs +++ b/src/Ringo.hs @@ -1,13 +1,15 @@ module Ringo where import Ringo.Types +-- import qualified Ringo.Tables as Tables -import qualified Data.Map as Map -import qualified Data.Text as T +import qualified Data.Map as Map +import qualified Data.Text as Text -import Data.Maybe (mapMaybe, fromMaybe, fromJust) +import Data.Maybe (mapMaybe, fromMaybe, fromJust) import Data.Monoid ((<>)) -import Data.List (nub, find) +import Data.List (nub, find) +import Data.Text (Text) data ValidationError = MissingTable TableName | MissingFact TableName @@ -35,23 +37,22 @@ validateTable tables table = concatMap checkConstraint . tableConstraints $ tabl checkConstraint (UniqueKey columnNames) = checkTableForColRefs table columnNames checkConstraint (ForeignKey oTableName columnNames) = case findTable oTableName tables of - Just oTable -> - checkTableForColRefs table (map fst columnNames) - ++ checkTableForColRefs oTable (map snd columnNames) - Nothing -> [MissingTable oTableName] + Just oTable -> checkTableForColRefs table (map fst columnNames) + ++ checkTableForColRefs oTable (map snd columnNames) + Nothing -> [ MissingTable oTableName ] checkTableForColRefs tab = concatMap (checkTableForCol tab) validateFact :: [Table] -> [Fact] -> Fact -> [ValidationError] validateFact tables facts Fact {..} = case findTable factTableName tables of - Nothing -> [MissingTable factTableName] + Nothing -> [ MissingTable factTableName ] Just table -> validateTable tables table - ++ concatMap checkFactParents factParentNames - ++ concatMap (checkColumn table) factColumns + ++ concatMap checkFactParents factParentNames + ++ concatMap (checkColumn table) factColumns where checkFactParents fName = case findFact fName facts of - Nothing -> [MissingFact fName] + Nothing -> [ MissingFact fName ] Just pFact -> validateFact tables facts pFact checkColumn table = maybe [] (checkTableForCol table) . factColumnName @@ -62,15 +63,13 @@ withFactValidation tables facts fact func = then Left errors 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 where dimsFromIds = - mapMaybe (\fcol -> case fcol of - DimId d _ -> findTable d tables - _ -> Nothing) - . factColumns - $ fact + flip mapMaybe (factColumns fact) $ \fcol -> case fcol of + DimId d _ -> findTable d tables + _ -> Nothing dimsFromVals = map (\(dim, cols) -> Table { tableName = prefix <> dim @@ -85,26 +84,22 @@ extractDimensions' tables prefix fact Table {..} = dimsFromIds ++ dimsFromVals . mapMaybe (\fcol -> do DimVal d col <- fcol column <- findColumn col tableColumns - return (d, [column])) + return (d, [ column ])) . map Just . factColumns $ fact 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 = withFactValidation tables facts fact $ extractDimensions' tables prefix fact -extractAllDimensions' :: [Table] -> [Fact] -> T.Text -> Fact -> Table -> [Table] -extractAllDimensions' tables facts dimPrefix fact table = nub go +extractAllDimensions' :: [Table] -> [Fact] -> Text -> Fact -> Table -> [Table] +extractAllDimensions' tables facts dimPrefix fact table = + nub $ extractDimensions' tables dimPrefix fact table ++ concatMap extract (factParentNames fact) where - go = extractDimensions' tables dimPrefix fact table ++ - if null $ factParentNames fact - then [] - else concatMap extract . factParentNames $ fact - extract fName = let pFact = fromJust . findFact fName $ facts 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 tables facts Settings {..} fact = - withFactValidation tables facts fact $ \table@Table{..} -> - let allDims = extractAllDimensions' tables facts settingDimPrefix fact table - sourceColumnType colName = columnType . fromJust $ findColumn colName tableColumns + withFactValidation tables facts fact $ \table -> + let intType = "integer" + allDims = extractAllDimensions' tables facts settingDimPrefix fact table + sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table + columns = flip concatMap (factColumns fact) $ \col -> case col of - DimTime cName -> [ Column (timeUnitColName cName) "integer" NotNull ] - NoDimId cName -> [ fromJust . findColumn cName $ tableColumns ] - FactCount cName -> [ Column cName "integer" NotNull ] + DimTime cName -> [ Column (timeUnitColName cName) intType NotNull ] + NoDimId cName -> [ fromJust . findColumn cName . tableColumns $ table] + FactCount cName -> [ Column cName intType 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 "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" - colNullable = if any ((== Null) . columnNullable) tCols then Null else NotNull - in (Column colName "integer" colNullable, ForeignKey tName [(colName, "id")]) - ukColNames = mapMaybe (\col -> case col of - DimTime cName -> Just (timeUnitColName cName) - NoDimId cName -> Just cName - _ -> Nothing) (factColumns fact) - ++ map (columnName . fst) fks - in Table { tableName = settingFactPrefix <> factName fact - , tableColumns = columns ++ map fst fks + + fks = flip map allDims $ \Table { .. } -> + let colName = fromMaybe tableName (Text.stripPrefix settingDimPrefix tableName) <> "_id" + colNullable = if any ((== Null) . columnNullable) tableColumns then Null else NotNull + in (Column colName intType colNullable, ForeignKey tableName [(colName, "id")]) + + ukColNames = + (++ map (columnName . fst) fks) + . flip mapMaybe (factColumns fact) $ \col -> case col of + DimTime cName -> Just (timeUnitColName cName) + NoDimId cName -> Just cName + _ -> Nothing + + in Table { tableName = settingFactPrefix <> factName fact + , tableColumns = columns ++ map fst fks , tableConstraints = UniqueKey ukColNames : map snd fks } where timeUnitColName colName = colName <> "_" <> timeUnitName settingTimeUnit <> "_id" - -