diff --git a/src/Ringo/Extractor.hs b/src/Ringo/Extractor.hs index 3498c1b..691b074 100644 --- a/src/Ringo/Extractor.hs +++ b/src/Ringo/Extractor.hs @@ -1,5 +1,6 @@ module Ringo.Extractor - ( extractDimensions + ( extractDimensionTables + , extractAllDimensionTables , extractFactTable ) where @@ -13,10 +14,11 @@ import Ringo.Extractor.Internal import Ringo.Types import Ringo.Utils -extractFactTable :: Fact -> Table -> Reader Env Table -extractFactTable fact table = do +extractFactTable :: Fact -> Reader Env Table +extractFactTable fact = do Settings {..} <- asks envSettings - allDims <- extractAllDimensions fact table + allDims <- extractAllDimensionTables fact + table <- asks $ fromJust . findTable (factTableName fact) . envTables let intType = "integer" sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table diff --git a/src/Ringo/Extractor/Internal.hs b/src/Ringo/Extractor/Internal.hs index d485717..2be549b 100644 --- a/src/Ringo/Extractor/Internal.hs +++ b/src/Ringo/Extractor/Internal.hs @@ -11,18 +11,23 @@ import Data.List (nub) import Ringo.Types import Ringo.Utils -extractDimensions :: Fact -> Table -> Reader Env [Table] -extractDimensions fact Table {..} = do - tables <- asks envTables - prefix <- settingDimPrefix <$> asks envSettings - return $ dimsFromIds tables ++ dimsFromVals prefix +dimColumnName :: Text.Text -> ColumnName -> ColumnName +dimColumnName dimName columnName = + fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName + +extractDimensionTables :: Fact -> Reader Env [Table] +extractDimensionTables fact = do + tables <- asks envTables + prefix <- settingDimPrefix <$> asks envSettings + let table = fromJust . findTable (factTableName fact) $ tables + return $ dimsFromIds tables ++ dimsFromVals prefix (tableColumns table) where dimsFromIds tables = flip mapMaybe (factColumns fact) $ \fcol -> case fcol of DimId d _ -> findTable d tables _ -> Nothing - dimsFromVals prefix = + dimsFromVals prefix tableColumns = map (\(dim, cols) -> Table { tableName = prefix <> dim , tableColumns = Column "id" "serial" NotNull : cols , tableConstraints = [ PrimaryKey "id" @@ -42,19 +47,12 @@ extractDimensions fact Table {..} = do . factColumns $ fact -dimColumnName :: Text.Text -> ColumnName -> ColumnName -dimColumnName dimName columnName = - fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName - -extractAllDimensions :: Fact -> Table -> Reader Env [Table] -extractAllDimensions fact table = do - myDims <- extractDimensions fact table +extractAllDimensionTables :: Fact -> Reader Env [Table] +extractAllDimensionTables fact = do + myDims <- extractDimensionTables fact parentDims <- concat <$> mapM extract (factParentNames fact) return . nub $ myDims ++ parentDims where extract fName = do - tables <- asks envTables facts <- asks envFacts - let pFact = fromJust . findFact fName $ facts - pFactTable = fromJust . findTable (factTableName pFact) $ tables - extractAllDimensions pFact pFactTable + extractAllDimensionTables . fromJust . findFact fName $ facts diff --git a/src/Ringo/Generator.hs b/src/Ringo/Generator.hs index b166184..1c5f7f3 100644 --- a/src/Ringo/Generator.hs +++ b/src/Ringo/Generator.hs @@ -5,10 +5,11 @@ module Ringo.Generator import qualified Data.Text as Text -import Data.List (intersperse) -import Data.Maybe (mapMaybe) -import Data.Monoid ((<>)) -import Data.Text (Text) +import Control.Monad.Reader (Reader, asks) +import Data.List (intersperse) +import Data.Maybe (mapMaybe) +import Data.Monoid ((<>)) +import Data.Text (Text) import Ringo.Extractor.Internal import Ringo.Types @@ -42,13 +43,16 @@ tableDefnSQL Table {..} = <> (Text.concat . intersperse ",\n" . map columnDefnSQL $ tableColumns) <> "\n)" -dimensionTableInsertSQL :: Text -> Fact -> TableName -> Text -dimensionTableInsertSQL dimPrefix fact dimTableName = let - colMapping = flip mapMaybe (factColumns fact) $ \fCol -> case fCol of - DimVal dName cName | dimPrefix <> dName == dimTableName -> Just (dimColumnName dName cName, cName) - _ -> Nothing - in "INSERT INTO " <> dimTableName <> " (\n" - <> colNamesString (map fst colMapping) - <> "\n) SELECT DISTINCT \n" - <> colNamesString (map snd colMapping) - <> "\nFROM " <> factTableName fact +dimensionTableInsertSQL :: Fact -> TableName -> Reader Env Text +dimensionTableInsertSQL fact dimTableName = do + dimPrefix <- settingDimPrefix <$> asks envSettings + let colMapping = flip mapMaybe (factColumns fact) $ \fCol -> case fCol of + DimVal dName cName | dimPrefix <> dName == dimTableName -> + Just (dimColumnName dName cName, cName) + _ -> Nothing + + return $ "INSERT INTO " <> dimTableName <> " (\n" + <> colNamesString (map fst colMapping) + <> "\n) SELECT DISTINCT \n" + <> colNamesString (map snd colMapping) + <> "\nFROM " <> factTableName fact diff --git a/src/Ringo/Validator.hs b/src/Ringo/Validator.hs index 4e4c4a0..0a650fb 100644 --- a/src/Ringo/Validator.hs +++ b/src/Ringo/Validator.hs @@ -1,8 +1,10 @@ -module Ringo.Validator where +module Ringo.Validator + ( validateTable + , validateFact + , withFactValidation + ) where import Control.Monad.Reader (Reader, asks) -import Data.Maybe (mapMaybe, fromMaybe, fromJust) -import Data.Monoid ((<>)) import Ringo.Types import Ringo.Utils @@ -46,11 +48,9 @@ validateFact Fact {..} = do checkColumn table = maybe [] (checkTableForCol table) . factColumnName -withFactValidation :: Fact -> (Table -> Reader Env a) - -> Reader Env (Either [ValidationError] a) +withFactValidation :: Fact -> Reader Env a -> Reader Env (Either [ValidationError] a) withFactValidation fact func = do - tables <- asks envTables errors <- validateFact fact if not $ null errors then return $ Left errors - else fmap Right . func . fromJust . findTable (factTableName fact) $ tables + else fmap Right func