From ade5c388d894d50d4aecc40c0a58018aabb02e28 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Fri, 5 Feb 2016 16:17:57 +0530 Subject: [PATCH] Adds a smart constructor for Env for better type safety. - Env is now created through a smart constructor which does validations. --- app/Main.hs | 13 +- app/Ringo/InputParser.hs | 3 +- ringo.cabal | 1 + src/Ringo.hs | 24 +-- src/Ringo/Extractor.hs | 91 +++++----- src/Ringo/Extractor/Internal.hs | 7 +- src/Ringo/Generator/Create.hs | 43 ++--- src/Ringo/Generator/Populate/Dimension.hs | 4 +- src/Ringo/Generator/Populate/Fact.hs | 181 +++++++++---------- src/Ringo/Types.hs | 203 +++------------------- src/Ringo/Types/Internal.hs | 198 +++++++++++++++++++++ src/Ringo/Utils.hs | 8 + src/Ringo/Validator.hs | 42 +++-- 13 files changed, 439 insertions(+), 379 deletions(-) create mode 100644 src/Ringo/Types/Internal.hs diff --git a/app/Main.hs b/app/Main.hs index f36329e..38f856f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + module Main where import qualified Data.ByteString.Lazy as BS @@ -8,7 +10,6 @@ import qualified Data.Text as Text import Data.Aeson (encode) import Data.Char (toLower) -import Data.List (nub) import Control.Monad (forM_) import System.Directory (createDirectoryIfMissing) import System.FilePath ((), (<.>)) @@ -27,14 +28,12 @@ main = do case result of Left err -> putStrLn err >> exitFailure Right (tables, facts, defaults) -> do - let env = Env tables facts progSettings defaults - let errors = nub $ concatMap (validateTable env) tables ++ concatMap (validateFact env) facts - if not $ null errors - then mapM_ print errors >> exitFailure - else writeFiles progOutputDir env >> exitSuccess + case makeEnv tables facts progSettings defaults of + Left errors -> mapM_ print errors >> exitFailure + Right env -> writeFiles progOutputDir env >> exitSuccess writeFiles :: FilePath -> Env -> IO () -writeFiles outputDir env@Env{..} = do +writeFiles outputDir env@(envView -> EnvV{..}) = do let Settings{..} = envSettings forM_ sqls $ \(sqlType, table, sql) -> do let dirName = outputDir map toLower (show sqlType) diff --git a/app/Ringo/InputParser.hs b/app/Ringo/InputParser.hs index c555006..8c8c183 100644 --- a/app/Ringo/InputParser.hs +++ b/app/Ringo/InputParser.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} + module Ringo.InputParser (parseInput) where import qualified Data.Text as Text @@ -85,5 +86,5 @@ parseInput :: FilePath -> IO (Either String ([Table], [Fact], TypeDefaults)) parseInput file = do result <- decodeFileEither file return $ case result of - Left pe -> Left $ prettyPrintParseException pe + Left pe -> Left $ prettyPrintParseException pe Right (Input tables facts defaults) -> Right (tables, facts, defaults) diff --git a/ringo.cabal b/ringo.cabal index f98d330..ad0113d 100644 --- a/ringo.cabal +++ b/ringo.cabal @@ -26,6 +26,7 @@ library Ringo.Generator.Create, Ringo.Generator.Populate.Dimension, Ringo.Generator.Populate.Fact, + Ringo.Types.Internal, Ringo.Utils build-depends: base >=4.7 && <5, text >=1.2 && <1.3, diff --git a/src/Ringo.hs b/src/Ringo.hs index 6e30c7b..4a270a4 100644 --- a/src/Ringo.hs +++ b/src/Ringo.hs @@ -12,8 +12,7 @@ module Ringo , factTableDefnSQL , dimensionTablePopulateSQL , factTablePopulateSQL - , validateTable - , validateFact + , makeEnv ) where import Control.Monad.Reader (runReader) @@ -135,9 +134,14 @@ import qualified Ringo.Validator as V -- , ("text", "'__UNKNOWN_VAL__'") -- ] -- settings = defSettings { settingTableNameSuffixTemplate = "" } --- env = Env tables facts settings typeDefaults +-- env = case makeEnv tables facts settings typeDefaults of +-- Left errors -> error . unlines . map show $ errors +-- Right env -> env -- :} +makeEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env +makeEnv = V.validateEnv + -- | -- -- >>> print $ extractFactTable env sessionFact @@ -615,17 +619,3 @@ dimensionTablePopulateSQL popMode env fact = factTablePopulateSQL :: TablePopulationMode -> Env -> Fact -> [Text] factTablePopulateSQL popMode env = flip runReader env . G.factTablePopulateSQL popMode - --- | --- --- >>> concatMap (validateTable env) tables --- [] -validateTable :: Env -> Table -> [ValidationError] -validateTable env = flip runReader env . V.validateTable - --- | --- --- >>> concatMap (validateFact env) facts --- [] -validateFact :: Env -> Fact -> [ValidationError] -validateFact env = flip runReader env . V.validateFact diff --git a/src/Ringo/Extractor.hs b/src/Ringo/Extractor.hs index 192acd8..0382797 100644 --- a/src/Ringo/Extractor.hs +++ b/src/Ringo/Extractor.hs @@ -11,7 +11,7 @@ module Ringo.Extractor import qualified Data.Map as Map import qualified Data.Tree as Tree -import Control.Monad.Reader (Reader, asks) +import Control.Monad.Reader (Reader, asks, withReader) import Data.Maybe (fromJust) import Data.Monoid ((<>)) import Data.List (nub) @@ -22,57 +22,58 @@ import Ringo.Utils extractFactTable :: Fact -> Reader Env Table extractFactTable fact = do - Settings {..} <- asks envSettings - allDims <- extractAllDimensionTables fact - tables <- asks envTables - let table = fromJust . findTable (factTableName fact) $ tables + allDims <- extractAllDimensionTables fact + withReader envView $ do + Settings {..} <- asks envSettings + tables <- asks envTables + let table = fromJust . findTable (factTableName fact) $ tables - let countColType = settingFactCountColumnType - dimIdColName = settingDimTableIdColumnName - sourceColumn cName = fromJust . findColumn cName . tableColumns $ table - notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull } - notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName } + let countColType = settingFactCountColumnType + dimIdColName = settingDimTableIdColumnName + sourceColumn cName = fromJust . findColumn cName . tableColumns $ table + notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull } + notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName } - columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> - case factColType of - DimTime -> - [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ] - NoDimId -> [ notNullSourceColumnCopy cName ] - TenantId -> [ notNullSourceColumnCopy cName ] - FactCount {..} -> [ Column cName countColType NotNull ] - FactCountDistinct {..} -> [ Column cName "json" NotNull ] - FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] - FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] - FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] - FactAverage {..} -> - [ Column (cName <> settingAvgCountColumSuffix) countColType NotNull - , notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix) - ] - _ -> [] + columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> + case factColType of + DimTime -> + [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ] + NoDimId -> [ notNullSourceColumnCopy cName ] + TenantId -> [ notNullSourceColumnCopy cName ] + FactCount {..} -> [ Column cName countColType NotNull ] + FactCountDistinct {..} -> [ Column cName "json" NotNull ] + FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] + FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] + FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] + FactAverage {..} -> + [ Column (cName <> settingAvgCountColumSuffix) countColType NotNull + , notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix) + ] + _ -> [] - fkColumns = for allDims $ \(dimFact, dimTable) -> - let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables - colType = idColTypeToFKIdColType settingDimTableIdColumnType - in Column colName colType NotNull + fkColumns = for allDims $ \(dimFact, dimTable) -> + let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables + colType = idColTypeToFKIdColType settingDimTableIdColumnType + in Column colName colType NotNull - ukColNames = - (++ map columnName fkColumns) - . forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> - case factColType of - DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit - NoDimId -> Just cName - TenantId -> Just cName - _ -> Nothing + ukColNames = + (++ map columnName fkColumns) + . forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> + case factColType of + DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit + NoDimId -> Just cName + TenantId -> Just cName + _ -> Nothing - return Table - { tableName = - extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit - , tableColumns = columns ++ fkColumns - , tableConstraints = [ UniqueKey ukColNames ] - } + return Table + { tableName = + extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit + , tableColumns = columns ++ fkColumns + , tableConstraints = [ UniqueKey ukColNames ] + } extractDependencies :: Fact -> Reader Env Dependencies -extractDependencies fact = do +extractDependencies fact = withReader envView $ do settings@Settings{..} <- asks envSettings facts <- asks envFacts let factSourceDeps = diff --git a/src/Ringo/Extractor/Internal.hs b/src/Ringo/Extractor/Internal.hs index 90d9690..264c0ba 100644 --- a/src/Ringo/Extractor/Internal.hs +++ b/src/Ringo/Extractor/Internal.hs @@ -13,7 +13,7 @@ import qualified Data.Text as Text import Control.Applicative ((<$>)) #endif -import Control.Monad.Reader (Reader, asks) +import Control.Monad.Reader (Reader, asks, withReader) import Data.Function (on) import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes) import Data.Monoid ((<>)) @@ -59,7 +59,7 @@ idColTypeToFKIdColType typ = case Text.toLower typ of _ -> typ extractDimensionTables :: Fact -> Reader Env [Table] -extractDimensionTables fact = do +extractDimensionTables fact = withReader envView $ do settings <- asks envSettings tables <- asks envTables let table = fromJust . findTable (factTableName fact) $ tables @@ -99,4 +99,5 @@ extractAllDimensionTables fact = do parentDims <- concat <$> mapM extract (factParentNames fact) return . nubBy ((==) `on` snd) $ myDims ++ parentDims where - extract fName = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName + extract fName = + asks (envFacts . envView) >>= extractAllDimensionTables . fromJust . findFact fName diff --git a/src/Ringo/Generator/Create.hs b/src/Ringo/Generator/Create.hs index 2cc40a1..0f34e70 100644 --- a/src/Ringo/Generator/Create.hs +++ b/src/Ringo/Generator/Create.hs @@ -11,7 +11,7 @@ module Ringo.Generator.Create (dimensionTableDefnSQL, factTableDefnSQL) where import Control.Applicative ((<$>)) #endif -import Control.Monad.Reader (Reader, asks) +import Control.Monad.Reader (Reader, asks, withReader) import Database.HsSqlPpp.Syntax ( Statement(..), RowConstraint(..), AlterTableAction(..) , AlterTableOperation(..), Constraint(..), Cascade(..) ) import Data.Maybe (listToMaybe, maybeToList) @@ -24,7 +24,7 @@ import Ringo.Types import Ringo.Utils tableDefnStmts :: Table -> Reader Env [Statement] -tableDefnStmts Table {..} = do +tableDefnStmts Table {..} = withReader envView $ do Settings {..} <- asks envSettings let tabName = tableName <> settingTableNameSuffixTemplate @@ -58,7 +58,7 @@ dimensionTableDefnSQL :: Table -> Reader Env [Text] dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts dimensionTableIndexStmts :: Table -> Reader Env [Statement] -dimensionTableIndexStmts Table {..} = do +dimensionTableIndexStmts Table {..} = withReader envView $do Settings {..} <- asks envSettings let tabName = tableName <> settingTableNameSuffixTemplate tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ] @@ -72,25 +72,26 @@ factTableDefnSQL fact table = tableDefnSQL table (factTableIndexStmts fact) factTableIndexStmts :: Fact -> Table -> Reader Env [Statement] factTableIndexStmts fact table = do - Settings {..} <- asks envSettings - tables <- asks envTables - allDims <- extractAllDimensionTables fact + allDims <- extractAllDimensionTables fact + withReader envView $ do + Settings {..} <- asks envSettings + tables <- asks envTables - let dimTimeCol = head [ cName | DimTimeV cName <- factColumns fact ] - tenantIdCol = listToMaybe [ cName | TenantIdV cName <- factColumns fact ] - tabName = tableName table <> settingTableNameSuffixTemplate - dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit + let dimTimeCol = head [ cName | DimTimeV cName <- factColumns fact ] + tenantIdCol = listToMaybe [ cName | TenantIdV cName <- factColumns fact ] + tabName = tableName table <> settingTableNameSuffixTemplate + dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit - factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> - case factColType of - DimTime -> Just [dimTimeColName cName] - NoDimId -> Just [cName] - TenantId -> Just [cName] - _ -> Nothing + factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> + case factColType of + DimTime -> Just [dimTimeColName cName] + NoDimId -> Just [cName] + TenantId -> Just [cName] + _ -> Nothing - dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ] - | (dimFact, dimTable) <- allDims ] + dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ] + | (dimFact, dimTable) <- allDims ] - return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols) - | cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol] - | cName <- maybeToList tenantIdCol ] ] + return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols) + | cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol] + | cName <- maybeToList tenantIdCol ] ] diff --git a/src/Ringo/Generator/Populate/Dimension.hs b/src/Ringo/Generator/Populate/Dimension.hs index 8ba028a..372e026 100644 --- a/src/Ringo/Generator/Populate/Dimension.hs +++ b/src/Ringo/Generator/Populate/Dimension.hs @@ -10,7 +10,7 @@ module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where import Control.Applicative ((<$>)) #endif -import Control.Monad.Reader (Reader, asks) +import Control.Monad.Reader (Reader, asks, withReader) import Database.HsSqlPpp.Syntax (Statement, QueryExpr(..), Distinct(..), makeSelect, JoinType(..)) import Data.Maybe (fromJust) import Data.Text (Text) @@ -25,7 +25,7 @@ dimensionTablePopulateSQL popMode fact dimTableName = ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement -dimensionTablePopulateStmt popMode fact dimTableName = do +dimensionTablePopulateStmt popMode fact dimTableName = withReader envView $ do Settings {..} <- asks envSettings tables <- asks envTables defaults <- asks envTypeDefaults diff --git a/src/Ringo/Generator/Populate/Fact.hs b/src/Ringo/Generator/Populate/Fact.hs index 494bbc4..1f5f1ae 100644 --- a/src/Ringo/Generator/Populate/Fact.hs +++ b/src/Ringo/Generator/Populate/Fact.hs @@ -16,7 +16,7 @@ import qualified Data.Text as Text import Control.Applicative ((<$>)) #endif -import Control.Monad.Reader (Reader, asks) +import Control.Monad.Reader (Reader, asks, withReader) import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect , SelectList(..), SelectItem(..), JoinType(..) ) import Data.List (nub) @@ -57,7 +57,7 @@ $$ LANGUAGE 'plpgsql' IMMUTABLE; |] -factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement] +factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader EnvV [Statement] factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of Select {selSelectList = SelectList _ origSelectItems, ..} -> do Settings {..} <- asks envSettings @@ -126,107 +126,108 @@ factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement] factTablePopulateStmts popMode fact = do - Settings {..} <- asks envSettings - allDims <- extractAllDimensionTables fact - tables <- asks envTables - defaults <- asks envTypeDefaults - let fTableName = factTableName fact - fTable = fromJust . findTable fTableName $ tables - dimIdColName = settingDimTableIdColumnName + allDims <- extractAllDimensionTables fact + withReader envView $ do + Settings {..} <- asks envSettings + tables <- asks envTables + defaults <- asks envTypeDefaults + let fTableName = factTableName fact + fTable = fromJust . findTable fTableName $ tables + dimIdColName = settingDimTableIdColumnName - coalesceFKId ex = - app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ] + coalesceFKId ex = + app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ] - timeUnitColumnInsertSQL cName = - let colName = timeUnitColumnName dimIdColName cName settingTimeUnit - in ( colName - , cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName)) - (num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ]) - "bigint" - , True - ) - dimIdColumnInsertSQL cName = - let sCol = fromJust . findColumn cName $ tableColumns fTable - in (cName, coalesceColumn defaults fTableName sCol, True) + timeUnitColumnInsertSQL cName = + let colName = timeUnitColumnName dimIdColName cName settingTimeUnit + in ( colName + , cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName)) + (num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ]) + "bigint" + , True + ) + dimIdColumnInsertSQL cName = + let sCol = fromJust . findColumn cName $ tableColumns fTable + in (cName, coalesceColumn defaults fTableName sCol, True) - app' f cName = app f [ eqi fTableName cName ] + app' f cName = app f [ eqi fTableName cName ] - factColMap = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> - case factColType of - DimTime -> [ timeUnitColumnInsertSQL cName ] - NoDimId -> [ dimIdColumnInsertSQL cName ] - TenantId -> [ dimIdColumnInsertSQL cName ] - FactCount {..} -> - [ (cName, app "count" [ maybe star (eqi fTableName) factColMaybeSourceColumn ], False) ] - FactCountDistinct {..} -> [ (cName, cast (str "{}") "json", False) ] - FactSum {..} -> [ (cName, app' "sum" factColSourceColumn, False) ] - FactMax {..} -> [ (cName, app' "max" factColSourceColumn, False) ] - FactMin {..} -> [ (cName, app' "min" factColSourceColumn, False) ] - FactAverage {..} -> - [ ( cName <> settingAvgCountColumSuffix, app' "count" factColSourceColumn, False ) - , ( cName <> settingAvgSumColumnSuffix , app' "sum" factColSourceColumn , False) - ] - _ -> [] + factColMap = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> + case factColType of + DimTime -> [ timeUnitColumnInsertSQL cName ] + NoDimId -> [ dimIdColumnInsertSQL cName ] + TenantId -> [ dimIdColumnInsertSQL cName ] + FactCount {..} -> + [ (cName, app "count" [ maybe star (eqi fTableName) factColMaybeSourceColumn ], False) ] + FactCountDistinct {..} -> [ (cName, cast (str "{}") "json", False) ] + FactSum {..} -> [ (cName, app' "sum" factColSourceColumn, False) ] + FactMax {..} -> [ (cName, app' "max" factColSourceColumn, False) ] + FactMin {..} -> [ (cName, app' "min" factColSourceColumn, False) ] + FactAverage {..} -> + [ ( cName <> settingAvgCountColumSuffix, app' "count" factColSourceColumn, False ) + , ( cName <> settingAvgSumColumnSuffix , app' "sum" factColSourceColumn , False) + ] + _ -> [] - dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let - dimFKIdColName = - factDimFKIdColumnName settingDimPrefix dimIdColName dimFact factTable tables - factSourceTableName = factTableName dimFact - factSourceTable = fromJust . findTable factSourceTableName $ tables - dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable - dimLookupWhereClauses = Just . foldBinop "and" $ - [ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol) - | (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName - , let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ] - insertExpr = if factTable `elem` tables -- existing dimension table - then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id) - $ eqi factSourceTableName dimFKIdColName - else coalesceFKId . subQueryExp $ - makeSelect - { selSelectList = sl [ si $ ei dimIdColName ] - , selTref = - [ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ] - , selWhere = dimLookupWhereClauses - } - in (dimFKIdColName, insertExpr, True) + dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let + dimFKIdColName = + factDimFKIdColumnName settingDimPrefix dimIdColName dimFact factTable tables + factSourceTableName = factTableName dimFact + factSourceTable = fromJust . findTable factSourceTableName $ tables + dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable + dimLookupWhereClauses = Just . foldBinop "and" $ + [ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol) + | (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName + , let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ] + insertExpr = if factTable `elem` tables -- existing dimension table + then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id) + $ eqi factSourceTableName dimFKIdColName + else coalesceFKId . subQueryExp $ + makeSelect + { selSelectList = sl [ si $ ei dimIdColName ] + , selTref = + [ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ] + , selWhere = dimLookupWhereClauses + } + in (dimFKIdColName, insertExpr, True) - colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy) - | (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ] + colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy) + | (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ] - joinClauses = - map (tref &&& joinClausePreds fTable) - . filter (/= fTableName) - . nub - . map (factTableName . fst) - $ allDims + joinClauses = + map (tref &&& joinClausePreds fTable) + . filter (/= fTableName) + . nub + . map (factTableName . fst) + $ allDims - timeCol = eqi fTableName $ head [ cName | DimTimeV cName <- factColumns fact ] + timeCol = eqi fTableName $ head [ cName | DimTimeV cName <- factColumns fact ] - extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate - $ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit + extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate + $ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit - populateSelectExpr = - makeSelect - { selSelectList = sl . map (uncurry sia . snd3) $ colMap - , selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ] - , selWhere = Just . foldBinop "and" $ - binop "<" timeCol placeholder : - [ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ] - , selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap - } + populateSelectExpr = + makeSelect + { selSelectList = sl . map (uncurry sia . snd3) $ colMap + , selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ] + , selWhere = Just . foldBinop "and" $ + binop "<" timeCol placeholder : + [ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ] + , selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap + } - insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr + insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr - updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr - return $ insertIntoStmt : updateStmts - where - groupByColPrefix = "xxff_" + updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr + return $ insertIntoStmt : updateStmts + where + groupByColPrefix = "xxff_" - joinClausePreds table oTableName = - foldBinop "and" - . map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2)) - <$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table - , tName == oTableName ] + joinClausePreds table oTableName = + foldBinop "and" + . map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2)) + <$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table + , tName == oTableName ] factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text] factTablePopulateSQL popMode fact = do diff --git a/src/Ringo/Types.hs b/src/Ringo/Types.hs index 24138d9..80bf6b3 100644 --- a/src/Ringo/Types.hs +++ b/src/Ringo/Types.hs @@ -5,186 +5,25 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE PatternSynonyms #-} -module Ringo.Types where +module Ringo.Types + ( ColumnName, ColumnType, TableName + , Nullable(..), Column(..), TableConstraint(..), Table(..) + , TimeUnit(..), timeUnitName, timeUnitToSeconds + , Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName + , pattern DimTimeV + , pattern NoDimIdV + , pattern TenantIdV + , pattern DimIdV + , pattern DimValV + , pattern FactCountV + , pattern FactCountDistinctV + , pattern FactSumV + , pattern FactAverageV + , pattern FactMaxV + , pattern FactMinV + , Settings(..), defSettings + , ValidationError(..), TypeDefaults + , Env, EnvV(..), envView + , TablePopulationMode(..), Dependencies) where -import qualified Data.Text as Text - -import Data.Map (Map) -import Data.Monoid ((<>)) -import Data.Text (Text) - -showColNames :: [Text] -> String -showColNames cols = Text.unpack $ "(" <> Text.intercalate ", " cols <> ")" - -type ColumnName = Text -type ColumnType = Text -type TableName = Text - -data Nullable = Null | NotNull deriving (Eq, Enum) - -instance Show Nullable where - show Null = "NULL" - show NotNull = "NOT NULL" - -data Column = Column - { columnName :: !ColumnName - , columnType :: !ColumnType - , columnNullable :: !Nullable - } deriving (Eq) - -instance Show Column where - show Column {..} = "Column " - ++ Text.unpack columnName ++ " " - ++ Text.unpack columnType ++ " " - ++ show columnNullable - -data TableConstraint = PrimaryKey !ColumnName - | UniqueKey ![ColumnName] - | ForeignKey !TableName ![(ColumnName, ColumnName)] - deriving (Eq) - -instance Show TableConstraint where - show (PrimaryKey col) = "PrimaryKey " ++ Text.unpack col - show (UniqueKey cols) = "UniqueKey " ++ showColNames cols - show (ForeignKey tName colMap) = "ForeignKey " ++ showColNames (map fst colMap) ++ " " - ++ Text.unpack tName ++ " " ++ showColNames (map snd colMap) -data Table = Table - { tableName :: !TableName - , tableColumns :: ![Column] - , tableConstraints :: ![TableConstraint] - } deriving (Eq) - -instance Show Table where - show Table {..} = - unlines $ ("Table " ++ Text.unpack tableName) : map show tableColumns ++ map show tableConstraints - -data TimeUnit = Second | Minute | Hour | Day | Week - deriving (Eq, Enum, Show, Read) - -timeUnitName :: TimeUnit -> Text -timeUnitName = Text.toLower . Text.pack . show - -timeUnitToSeconds :: TimeUnit -> Int -timeUnitToSeconds Second = 1 -timeUnitToSeconds Minute = 60 * timeUnitToSeconds Second -timeUnitToSeconds Hour = 60 * timeUnitToSeconds Minute -timeUnitToSeconds Day = 24 * timeUnitToSeconds Hour -timeUnitToSeconds Week = 7 * timeUnitToSeconds Day - -data Fact = Fact - { factName :: !TableName - , factTableName :: !TableName - , factTablePersistent :: !Bool - , factParentNames :: ![TableName] - , factColumns :: ![FactColumn] - } deriving (Show) - -data FCTNone -data FCTTargetTable -data FCTMaybeSourceColumn -data FCTSourceColumn - -data FactColumnType a where - DimTime :: FactColumnType FCTNone - NoDimId :: FactColumnType FCTNone - TenantId :: FactColumnType FCTNone - DimId :: { factColTargetTable :: !TableName } -> FactColumnType FCTTargetTable - DimVal :: { factColTargetTable :: !TableName } -> FactColumnType FCTTargetTable - FactCount :: { factColMaybeSourceColumn :: !(Maybe ColumnName) } -> FactColumnType FCTMaybeSourceColumn - FactCountDistinct :: { factColMaybeSourceColumn :: !(Maybe ColumnName) } -> FactColumnType FCTMaybeSourceColumn - FactSum :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn - FactAverage :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn - FactMax :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn - FactMin :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn - -deriving instance Show (FactColumnType a) - -pattern DimTimeV col <- FactColumn col DimTime -pattern NoDimIdV col <- FactColumn col NoDimId -pattern TenantIdV col <- FactColumn col TenantId -pattern DimIdV col <- FactColumn col DimId {..} -pattern DimValV col <- FactColumn col DimVal {..} -pattern FactCountV col <- FactColumn col FactCount {..} -pattern FactCountDistinctV col <- FactColumn col FactCountDistinct {..} -pattern FactSumV col <- FactColumn col FactSum {..} -pattern FactAverageV col <- FactColumn col FactAverage {..} -pattern FactMaxV col <- FactColumn col FactMax {..} -pattern FactMinV col <- FactColumn col FactMin {..} - -data FactColumn = forall a. FactColumn - { factColTargetColumn :: !ColumnName - , factColType :: FactColumnType a } - -deriving instance Show FactColumn - -factSourceColumnName :: FactColumn -> Maybe ColumnName -factSourceColumnName FactColumn {..} = case factColType of - DimTime -> Just factColTargetColumn - NoDimId -> Just factColTargetColumn - TenantId -> Just factColTargetColumn - DimId {..} -> Just factColTargetColumn - DimVal {..} -> Just factColTargetColumn - FactCount {..} -> factColMaybeSourceColumn - FactCountDistinct {..} -> factColMaybeSourceColumn - FactSum {..} -> Just factColSourceColumn - FactAverage {..} -> Just factColSourceColumn - FactMax {..} -> Just factColSourceColumn - FactMin {..} -> Just factColSourceColumn - -data Settings = Settings - { settingDimPrefix :: !Text - , settingFactPrefix :: !Text - , settingTimeUnit :: !TimeUnit - , settingAvgCountColumSuffix :: !Text - , settingAvgSumColumnSuffix :: !Text - , settingDimTableIdColumnName :: !Text - , settingDimTableIdColumnType :: !Text - , settingFactCountColumnType :: !Text - , settingFactCountDistinctErrorRate :: !Double - , settingFactInfix :: !Text - , settingDependenciesJSONFileName :: !Text - , settingFactsJSONFileName :: !Text - , settingDimensionJSONFileName :: !Text - , settingForeignKeyIdCoalesceValue :: !Int - , settingTableNameSuffixTemplate :: !Text - } deriving (Eq, Show) - -defSettings :: Settings -defSettings = Settings - { settingDimPrefix = "dim_" - , settingFactPrefix = "fact_" - , settingTimeUnit = Minute - , settingAvgCountColumSuffix = "_count" - , settingAvgSumColumnSuffix = "_sum" - , settingDimTableIdColumnName = "id" - , settingDimTableIdColumnType = "serial" - , settingFactCountColumnType = "integer" - , settingFactCountDistinctErrorRate = 0.05 - , settingFactInfix = "_by_" - , settingDependenciesJSONFileName = "dependencies.json" - , settingFactsJSONFileName = "facts.json" - , settingDimensionJSONFileName = "dimensions.json" - , settingForeignKeyIdCoalesceValue = -1 - , settingTableNameSuffixTemplate = "{{suff}}" - } - -data ValidationError = MissingTable !TableName - | MissingFact !TableName - | MissingColumn !TableName !ColumnName - | MissingTimeColumn !TableName - | MissingNotNullConstraint !TableName !ColumnName - | MissingTypeDefault !Text - deriving (Eq, Show) - -type TypeDefaults = Map Text Text - -data Env = Env - { envTables :: ![Table] - , envFacts :: ![Fact] - , envSettings :: !Settings - , envTypeDefaults :: !TypeDefaults - } deriving (Show) - -data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show) - -type Dependencies = Map TableName [TableName] +import Ringo.Types.Internal diff --git a/src/Ringo/Types/Internal.hs b/src/Ringo/Types/Internal.hs new file mode 100644 index 0000000..aee8390 --- /dev/null +++ b/src/Ringo/Types/Internal.hs @@ -0,0 +1,198 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE PatternSynonyms #-} + +module Ringo.Types.Internal where + +import qualified Data.Text as Text + +import Data.Map (Map) +import Data.Monoid ((<>)) +import Data.Text (Text) + +showColNames :: [Text] -> String +showColNames cols = Text.unpack $ "(" <> Text.intercalate ", " cols <> ")" + +type ColumnName = Text +type ColumnType = Text +type TableName = Text + +data Nullable = Null | NotNull deriving (Eq, Enum) + +instance Show Nullable where + show Null = "NULL" + show NotNull = "NOT NULL" + +data Column = Column + { columnName :: !ColumnName + , columnType :: !ColumnType + , columnNullable :: !Nullable + } deriving (Eq) + +instance Show Column where + show Column {..} = "Column " + ++ Text.unpack columnName ++ " " + ++ Text.unpack columnType ++ " " + ++ show columnNullable + +data TableConstraint = PrimaryKey !ColumnName + | UniqueKey ![ColumnName] + | ForeignKey !TableName ![(ColumnName, ColumnName)] + deriving (Eq) + +instance Show TableConstraint where + show (PrimaryKey col) = "PrimaryKey " ++ Text.unpack col + show (UniqueKey cols) = "UniqueKey " ++ showColNames cols + show (ForeignKey tName colMap) = "ForeignKey " ++ showColNames (map fst colMap) ++ " " + ++ Text.unpack tName ++ " " ++ showColNames (map snd colMap) +data Table = Table + { tableName :: !TableName + , tableColumns :: ![Column] + , tableConstraints :: ![TableConstraint] + } deriving (Eq) + +instance Show Table where + show Table {..} = + unlines $ ("Table " ++ Text.unpack tableName) : map show tableColumns ++ map show tableConstraints + +data TimeUnit = Second | Minute | Hour | Day | Week + deriving (Eq, Enum, Show, Read) + +timeUnitName :: TimeUnit -> Text +timeUnitName = Text.toLower . Text.pack . show + +timeUnitToSeconds :: TimeUnit -> Int +timeUnitToSeconds Second = 1 +timeUnitToSeconds Minute = 60 * timeUnitToSeconds Second +timeUnitToSeconds Hour = 60 * timeUnitToSeconds Minute +timeUnitToSeconds Day = 24 * timeUnitToSeconds Hour +timeUnitToSeconds Week = 7 * timeUnitToSeconds Day + +data Fact = Fact + { factName :: !TableName + , factTableName :: !TableName + , factTablePersistent :: !Bool + , factParentNames :: ![TableName] + , factColumns :: ![FactColumn] + } deriving (Show) + +data FCTNone +data FCTTargetTable +data FCTMaybeSourceColumn +data FCTSourceColumn + +data FactColumnType a where + DimTime :: FactColumnType FCTNone + NoDimId :: FactColumnType FCTNone + TenantId :: FactColumnType FCTNone + DimId :: { factColTargetTable :: !TableName } -> FactColumnType FCTTargetTable + DimVal :: { factColTargetTable :: !TableName } -> FactColumnType FCTTargetTable + FactCount :: { factColMaybeSourceColumn :: !(Maybe ColumnName) } -> FactColumnType FCTMaybeSourceColumn + FactCountDistinct :: { factColMaybeSourceColumn :: !(Maybe ColumnName) } -> FactColumnType FCTMaybeSourceColumn + FactSum :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn + FactAverage :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn + FactMax :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn + FactMin :: { factColSourceColumn :: !ColumnName } -> FactColumnType FCTSourceColumn + +deriving instance Show (FactColumnType a) + +pattern DimTimeV col <- FactColumn col DimTime +pattern NoDimIdV col <- FactColumn col NoDimId +pattern TenantIdV col <- FactColumn col TenantId +pattern DimIdV col <- FactColumn col DimId {..} +pattern DimValV col <- FactColumn col DimVal {..} +pattern FactCountV col <- FactColumn col FactCount {..} +pattern FactCountDistinctV col <- FactColumn col FactCountDistinct {..} +pattern FactSumV col <- FactColumn col FactSum {..} +pattern FactAverageV col <- FactColumn col FactAverage {..} +pattern FactMaxV col <- FactColumn col FactMax {..} +pattern FactMinV col <- FactColumn col FactMin {..} + +data FactColumn = forall a. FactColumn + { factColTargetColumn :: !ColumnName + , factColType :: FactColumnType a } + +deriving instance Show FactColumn + +factSourceColumnName :: FactColumn -> Maybe ColumnName +factSourceColumnName FactColumn {..} = case factColType of + DimTime -> Just factColTargetColumn + NoDimId -> Just factColTargetColumn + TenantId -> Just factColTargetColumn + DimId {..} -> Just factColTargetColumn + DimVal {..} -> Just factColTargetColumn + FactCount {..} -> factColMaybeSourceColumn + FactCountDistinct {..} -> factColMaybeSourceColumn + FactSum {..} -> Just factColSourceColumn + FactAverage {..} -> Just factColSourceColumn + FactMax {..} -> Just factColSourceColumn + FactMin {..} -> Just factColSourceColumn + +data Settings = Settings + { settingDimPrefix :: !Text + , settingFactPrefix :: !Text + , settingTimeUnit :: !TimeUnit + , settingAvgCountColumSuffix :: !Text + , settingAvgSumColumnSuffix :: !Text + , settingDimTableIdColumnName :: !Text + , settingDimTableIdColumnType :: !Text + , settingFactCountColumnType :: !Text + , settingFactCountDistinctErrorRate :: !Double + , settingFactInfix :: !Text + , settingDependenciesJSONFileName :: !Text + , settingFactsJSONFileName :: !Text + , settingDimensionJSONFileName :: !Text + , settingForeignKeyIdCoalesceValue :: !Int + , settingTableNameSuffixTemplate :: !Text + } deriving (Eq, Show) + +defSettings :: Settings +defSettings = Settings + { settingDimPrefix = "dim_" + , settingFactPrefix = "fact_" + , settingTimeUnit = Minute + , settingAvgCountColumSuffix = "_count" + , settingAvgSumColumnSuffix = "_sum" + , settingDimTableIdColumnName = "id" + , settingDimTableIdColumnType = "serial" + , settingFactCountColumnType = "integer" + , settingFactCountDistinctErrorRate = 0.05 + , settingFactInfix = "_by_" + , settingDependenciesJSONFileName = "dependencies.json" + , settingFactsJSONFileName = "facts.json" + , settingDimensionJSONFileName = "dimensions.json" + , settingForeignKeyIdCoalesceValue = -1 + , settingTableNameSuffixTemplate = "{{suff}}" + } + +data ValidationError = MissingTable !TableName + | DuplicateTable !TableName + | MissingFact !TableName + | DuplicateFact !TableName + | MissingColumn !TableName !ColumnName + | DuplicateColumn !TableName !ColumnName + | MissingTimeColumn !TableName + | MissingNotNullConstraint !TableName !ColumnName + | MissingTypeDefault !Text + deriving (Eq, Show) + +type TypeDefaults = Map Text Text + +data Env = Env ![Table] ![Fact] !Settings !TypeDefaults + +data EnvV = EnvV + { envTables :: ![Table] + , envFacts :: ![Fact] + , envSettings :: !Settings + , envTypeDefaults :: !TypeDefaults + } deriving (Show) + +envView :: Env -> EnvV +envView (Env tables facts settings typeDefaults) = EnvV tables facts settings typeDefaults + +data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show) + +type Dependencies = Map TableName [TableName] diff --git a/src/Ringo/Utils.hs b/src/Ringo/Utils.hs index e27980d..1e8a81b 100644 --- a/src/Ringo/Utils.hs +++ b/src/Ringo/Utils.hs @@ -34,6 +34,14 @@ second = Arrow.second (&&&) :: (a -> b) -> (a -> c) -> a -> (b, c) (&&&) = (Arrow.&&&) +(>>>) :: (a -> b) -> (b -> c) -> (a -> c) +(>>>) = (Arrow.>>>) + +(>>-) :: a -> (a -> b) -> b +(>>-) v f = f v + +infixr 1 >>- + dupe :: a -> (a,a) dupe x = (x, x) diff --git a/src/Ringo/Validator.hs b/src/Ringo/Validator.hs index c22e083..fb49e48 100644 --- a/src/Ringo/Validator.hs +++ b/src/Ringo/Validator.hs @@ -4,10 +4,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} -module Ringo.Validator - ( validateTable - , validateFact - ) where +module Ringo.Validator (validateEnv) where import qualified Data.Map as Map import qualified Data.Text as Text @@ -17,20 +14,25 @@ import qualified Data.Text as Text import Control.Applicative ((<$>)) #endif -import Control.Monad.Reader (Reader, asks) +import Control.Monad.Reader (Reader, ask, runReader) import Data.Maybe (isJust, fromJust) +import Data.List (nub, group, sort) import Ringo.Extractor.Internal import Ringo.Types +import Ringo.Types.Internal +import Ringo.Utils + +data RawEnv = RawEnv ![Table] ![Fact] !Settings !TypeDefaults deriving (Show) checkTableForCol :: Table -> ColumnName -> [ValidationError] checkTableForCol tab colName = [ MissingColumn (tableName tab) colName | not . any ((colName ==) . columnName) . tableColumns $ tab ] -validateTable :: Table -> Reader Env [ValidationError] +validateTable :: Table -> Reader RawEnv [ValidationError] validateTable table = do - tables <- asks envTables + RawEnv tables _ _ _ <- ask return . concatMap (checkConstraint tables) . tableConstraints $ table where checkConstraint _ (PrimaryKey colName) = checkTableForCol table colName @@ -43,10 +45,10 @@ validateTable table = do checkTableForColRefs tab = concatMap (checkTableForCol tab) -validateFact :: Fact -> Reader Env [ValidationError] +validateFact :: Fact -> Reader RawEnv [ValidationError] validateFact Fact {..} = do - tables <- asks envTables - defaults <- Map.keys <$> asks envTypeDefaults + RawEnv tables _ _ typeDefaults <- ask + let defaults = Map.keys typeDefaults case findTable factTableName tables of Nothing -> return [ MissingTable factTableName ] Just table -> do @@ -75,7 +77,7 @@ validateFact Fact {..} = do return $ tableVs ++ parentVs ++ colVs ++ timeVs ++ notNullVs ++ typeDefaultVs where checkFactParents fName = do - facts <- asks envFacts + RawEnv _ facts _ _ <- ask case findFact fName facts of Nothing -> return [ MissingFact fName ] Just pFact -> validateFact pFact @@ -88,3 +90,21 @@ validateFact Fact {..} = do checkColumnTable tables FactColumn {..} = case factColType of DimId {factColTargetTable = tName} -> maybe [ MissingTable tName ] (const []) $ findTable tName tables _ -> [] + +validateEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env +validateEnv tables facts settings typeDefaults = + flip runReader (RawEnv tables facts settings typeDefaults) $ do + tableVs <- concat <$> mapM validateTable tables + factVs <- concat <$> mapM validateFact facts + let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ] + let dupFactVs = [ DuplicateFact fact | fact <- findDups . map factName $ facts ] + let dupColVs = [ DuplicateColumn tableName col + | Table{..} <- tables + , col <- findDups . map columnName $ tableColumns ] + let vs = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs + if null vs + then return . Right $ Env tables facts settings typeDefaults + else return . Left $ vs + where + findDups = + sort >>> group >>> map (head &&& length) >>> filter (snd >>> (> 1)) >>> map fst