diff --git a/ringo/src/Ringo/Extractor/Internal.hs b/ringo/src/Ringo/Extractor/Internal.hs index c301efc..5486a9f 100644 --- a/ringo/src/Ringo/Extractor/Internal.hs +++ b/ringo/src/Ringo/Extractor/Internal.hs @@ -35,6 +35,18 @@ dimColumnName :: Text -> ColumnName -> ColumnName dimColumnName dimName columnName = fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName +dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)] +dimColumnMapping dimPrefix fact dimTableName = + [ (dimColumnName factColTargetTable factColTargetColumn, factColTargetColumn) + | FactColumn { factColType = DimVal {..}, ..} <- factColumns fact + , dimPrefix <> factColTargetTable == dimTableName ] + +dimColumnMappings :: Text -> Fact -> [(TableName, [(ColumnName, ColumnName)])] +dimColumnMappings dimPrefix fact = + nub [ (dimTableName, dimColumnMapping dimPrefix fact dimTableName) + | FactColumn { factColType = DimVal {..}, ..} <- factColumns fact + , let dimTableName = dimPrefix <> factColTargetTable ] + timeUnitColumnName :: Text -> ColumnName -> TimeUnit -> ColumnName timeUnitColumnName dimIdColName colName timeUnit = colName <> "_" <> timeUnitName timeUnit <> "_" <> dimIdColName diff --git a/ringo/src/Ringo/Generator/Internal.hs b/ringo/src/Ringo/Generator/Internal.hs index f1fdbcf..08fa4dd 100644 --- a/ringo/src/Ringo/Generator/Internal.hs +++ b/ringo/src/Ringo/Generator/Internal.hs @@ -7,7 +7,7 @@ import qualified Data.Map as Map import qualified Data.Text as Text import Database.HsSqlPpp.Syntax (ScalarExpr) -import Data.List (find) +import Data.List (find, nub) import Data.Monoid ((<>)) import Data.Text (Text) @@ -15,12 +15,6 @@ import Ringo.Extractor.Internal import Ringo.Generator.Sql import Ringo.Types -dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)] -dimColumnMapping dimPrefix fact dimTableName = - [ (dimColumnName factColTargetTable factColTargetColumn, factColTargetColumn) - | FactColumn { factColType = DimVal {..}, ..} <- factColumns fact - , dimPrefix <> factColTargetTable == dimTableName ] - coalesceColumn :: TypeDefaults -> TableName -> Column -> ScalarExpr coalesceColumn defaults tName Column{..} = if columnNullable == Null diff --git a/ringo/src/Ringo/Types.hs b/ringo/src/Ringo/Types.hs index 4b2b56e..8eecd97 100644 --- a/ringo/src/Ringo/Types.hs +++ b/ringo/src/Ringo/Types.hs @@ -3,13 +3,32 @@ {-# LANGUAGE Rank2Types #-} module Ringo.Types - ( ColumnName, ColumnType, TableName - , Nullable(..), Column(..), TableConstraint(..), Table(..) - , TimeUnit(..), timeUnitName, timeUnitToSeconds - , Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName - , Settings(..), defSettings - , ValidationError(..), TypeDefaults - , Env, envTables, envFacts, envSettings, envTypeDefaults, - TablePopulationMode(..), Dependencies) where + ( ColumnName + , ColumnType + , TableName + , Nullable(..) + , Column(..) + , TableConstraint(..) + , Table(..) + , TimeUnit(..) + , timeUnitName + , timeUnitToSeconds + , Fact(..) + , FactColumnKind(..) + , FactColumnType(..) + , FactColumn(..) + , factSourceColumnName + , Settings(..) + , defSettings + , ValidationError(..) + , TypeDefaults + , Env + , envTables + , envFacts + , envSettings + , envTypeDefaults + , TablePopulationMode(..) + , Dependencies + ) where import Ringo.Types.Internal diff --git a/ringo/src/Ringo/Types/Internal.hs b/ringo/src/Ringo/Types/Internal.hs index 6c6bbbe..ebffbfc 100644 --- a/ringo/src/Ringo/Types/Internal.hs +++ b/ringo/src/Ringo/Types/Internal.hs @@ -161,6 +161,7 @@ data ValidationError = MissingTable !TableName | MissingColumn !TableName !ColumnName | DuplicateColumn !TableName !ColumnName | MissingTimeColumn !TableName + | DuplicateDimension !TableName | MissingNotNullConstraint !TableName !ColumnName | MissingTypeDefault !Text deriving (Eq, Show) diff --git a/ringo/src/Ringo/Validator.hs b/ringo/src/Ringo/Validator.hs index 547e98c..e773f3f 100644 --- a/ringo/src/Ringo/Validator.hs +++ b/ringo/src/Ringo/Validator.hs @@ -15,8 +15,9 @@ import Control.Applicative ((<$>)) #endif import Control.Monad.Reader (Reader, ask, runReader) +import Data.Function (on) import Data.Maybe (isJust, fromJust) -import Data.List (nub, group, sort) +import Data.List (nub, group, groupBy, sort) import Ringo.Extractor.Internal import Ringo.Types @@ -92,7 +93,7 @@ validateFact Fact {..} = do _ -> [] validateEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env -validateEnv tables facts settings typeDefaults = +validateEnv tables facts settings@Settings {..} typeDefaults = flip runReader (RawEnv tables facts settings typeDefaults) $ do tableVs <- concat <$> mapM validateTable tables factVs <- concat <$> mapM validateFact facts @@ -101,7 +102,13 @@ validateEnv tables facts settings typeDefaults = let dupColVs = [ DuplicateColumn tableName col | Table{..} <- tables , col <- findDups . map columnName $ tableColumns ] - let vs = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs + let dupDimVs = facts + >>- concatMap (dimColumnMappings settingDimPrefix) + >>> sort + >>> groupBy ((==) `on` fst) + >>> filter (map snd >>> nub >>> length >>> (/= 1)) + >>> map (head >>> fst >>> DuplicateDimension) + vs = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs if null vs then return . Right $ Env tables facts settings typeDefaults else return . Left $ vs