From 6e1341b52ac70f4b5d01835c909c9de329d1f6c7 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Tue, 15 Dec 2015 18:22:51 +0530 Subject: [PATCH] Adds dimension table insert SQL generation. Moves some private functions from Extractor to Extractor.Internal for reuse. --- src/Ringo/Extractor.hs | 62 +--------------------------- src/Ringo/Extractor/Internal.hs | 73 +++++++++++++++++++++++++++++++++ src/Ringo/Generator.hs | 29 +++++++++---- 3 files changed, 96 insertions(+), 68 deletions(-) create mode 100644 src/Ringo/Extractor/Internal.hs diff --git a/src/Ringo/Extractor.hs b/src/Ringo/Extractor.hs index d407e0b..6462837 100644 --- a/src/Ringo/Extractor.hs +++ b/src/Ringo/Extractor.hs @@ -5,30 +5,15 @@ module Ringo.Extractor , extractFactTable ) where -import qualified Data.Map as Map import qualified Data.Text as Text import Control.Monad.Reader (Reader, asks) import Data.Maybe (mapMaybe, fromMaybe, fromJust) import Data.Monoid ((<>)) -import Data.List (nub, find) +import Ringo.Extractor.Internal import Ringo.Types -findTable :: TableName -> [Table] -> Maybe Table -findTable tName = find ((== tName) . tableName) - -findFact :: TableName -> [Fact] -> Maybe Fact -findFact fName = find ((== fName) . factName) - -findColumn :: ColumnName -> [Column] -> Maybe Column -findColumn cName = find ((== cName) . columnName) - -checkTableForCol :: Table -> ColumnName -> [ValidationError] -checkTableForCol tab colName = - [ MissingColumn (tableName tab) colName | - not . any ((colName ==) . columnName) . tableColumns $ tab ] - validateTable :: Table -> Reader ExtractorEnv [ValidationError] validateTable table = do tables <- asks eeTables @@ -72,54 +57,9 @@ withFactValidation fact func = do then return $ Left errors else fmap Right . func . fromJust . findTable (factTableName fact) $ tables -extractDimensions' :: Fact -> Table -> Reader ExtractorEnv [Table] -extractDimensions' fact Table {..} = do - tables <- asks eeTables - prefix <- settingDimPrefix <$> asks eeSettings - return $ dimsFromIds tables ++ dimsFromVals prefix - where - dimsFromIds tables = - flip mapMaybe (factColumns fact) $ \fcol -> case fcol of - DimId d _ -> findTable d tables - _ -> Nothing - - dimsFromVals prefix = - map (\(dim, cols) -> Table { tableName = prefix <> dim - , tableColumns = Column "id" "serial" NotNull : cols - , tableConstraints = [ PrimaryKey "id" - , UniqueKey (map columnName cols) - ] - }) - . Map.toList - . Map.mapWithKey (\dim -> map (cleanColumn dim) . nub) - . Map.fromListWith (flip (++)) - . mapMaybe (\fcol -> do - DimVal d col <- fcol - column <- findColumn col tableColumns - return (d, [ column ])) - . map Just - . factColumns - $ fact - - cleanColumn dim col@Column {..} = - col { columnName = fromMaybe columnName . Text.stripPrefix (dim <> "_") $ columnName } - extractDimensions :: Fact -> Reader ExtractorEnv (Either [ValidationError] [Table]) extractDimensions fact = withFactValidation fact $ extractDimensions' fact -extractAllDimensions' :: Fact -> Table -> Reader ExtractorEnv [Table] -extractAllDimensions' fact table = do - myDims <- extractDimensions' fact table - parentDims <- concat <$> mapM extract (factParentNames fact) - return . nub $ myDims ++ parentDims - where - extract fName = do - tables <- asks eeTables - facts <- asks eeFacts - let pFact = fromJust . findFact fName $ facts - pFactTable = fromJust . findTable (factTableName pFact) $ tables - extractAllDimensions' pFact pFactTable - extractFactTable :: Fact -> Reader ExtractorEnv (Either [ValidationError] Table) extractFactTable fact = withFactValidation fact $ \table -> do diff --git a/src/Ringo/Extractor/Internal.hs b/src/Ringo/Extractor/Internal.hs new file mode 100644 index 0000000..191c6ab --- /dev/null +++ b/src/Ringo/Extractor/Internal.hs @@ -0,0 +1,73 @@ +module Ringo.Extractor.Internal where + +import qualified Data.Map as Map +import qualified Data.Text as Text + +import Control.Monad.Reader (Reader, asks) +import Data.Maybe (mapMaybe, fromMaybe, fromJust) +import Data.Monoid ((<>)) +import Data.List (nub, find) + +import Ringo.Types + +findTable :: TableName -> [Table] -> Maybe Table +findTable tName = find ((== tName) . tableName) + +findFact :: TableName -> [Fact] -> Maybe Fact +findFact fName = find ((== fName) . factName) + +findColumn :: ColumnName -> [Column] -> Maybe Column +findColumn cName = find ((== cName) . columnName) + +checkTableForCol :: Table -> ColumnName -> [ValidationError] +checkTableForCol tab colName = + [ MissingColumn (tableName tab) colName | + not . any ((colName ==) . columnName) . tableColumns $ tab ] + +extractDimensions' :: Fact -> Table -> Reader ExtractorEnv [Table] +extractDimensions' fact Table {..} = do + tables <- asks eeTables + prefix <- settingDimPrefix <$> asks eeSettings + return $ dimsFromIds tables ++ dimsFromVals prefix + where + dimsFromIds tables = + flip mapMaybe (factColumns fact) $ \fcol -> case fcol of + DimId d _ -> findTable d tables + _ -> Nothing + + dimsFromVals prefix = + map (\(dim, cols) -> Table { tableName = prefix <> dim + , tableColumns = Column "id" "serial" NotNull : cols + , tableConstraints = [ PrimaryKey "id" + , UniqueKey (map columnName cols) + ] + }) + . Map.toList + . Map.mapWithKey (\dim -> + map (\col@Column {..} -> col { columnName = dimColumnName dim columnName }) + . nub) + . Map.fromListWith (flip (++)) + . mapMaybe (\fcol -> do + DimVal d col <- fcol + column <- findColumn col tableColumns + return (d, [ column ])) + . map Just + . factColumns + $ fact + +dimColumnName :: Text.Text -> ColumnName -> ColumnName +dimColumnName dimName columnName = + fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName + +extractAllDimensions' :: Fact -> Table -> Reader ExtractorEnv [Table] +extractAllDimensions' fact table = do + myDims <- extractDimensions' fact table + parentDims <- concat <$> mapM extract (factParentNames fact) + return . nub $ myDims ++ parentDims + where + extract fName = do + tables <- asks eeTables + facts <- asks eeFacts + let pFact = fromJust . findFact fName $ facts + pFactTable = fromJust . findTable (factTableName pFact) $ tables + extractAllDimensions' pFact pFactTable diff --git a/src/Ringo/Generator.hs b/src/Ringo/Generator.hs index 6335c0a..541f695 100644 --- a/src/Ringo/Generator.hs +++ b/src/Ringo/Generator.hs @@ -1,13 +1,16 @@ module Ringo.Generator ( tableDefnSQL + , dimensionTableInsertSQL ) where import qualified Data.Text as Text -import Data.List (intersperse) +import Data.List (intersperse) +import Data.Maybe (mapMaybe) import Data.Monoid ((<>)) -import Data.Text (Text) +import Data.Text (Text) +import Ringo.Extractor.Internal import Ringo.Types nullableDefnSQL :: Nullable -> Text @@ -18,17 +21,18 @@ columnDefnSQL :: Column -> Text columnDefnSQL Column {..} = columnName <> " " <> columnType <> " " <> nullableDefnSQL columnNullable +colNamesString :: [ColumnName] -> Text +colNamesString cNames = Text.concat (intersperse ", " cNames) + constraintDefnSQL :: TableName -> TableConstraint -> Text constraintDefnSQL tableName constraint = "ALTER TABLE ONLY " <> tableName <> " ADD " <> case constraint of PrimaryKey cName -> "PRIMARY KEY (" <> cName <> ")" - UniqueKey cNames -> "UNIQUE (" <> colNamesStr cNames <> ")" + UniqueKey cNames -> "UNIQUE (" <> colNamesString cNames <> ")" ForeignKey oTableName cNamePairs -> - "FOREIGN KEY (" <> colNamesStr (map fst cNamePairs) <> ") REFERENCES " - <> oTableName <> " (" <> colNamesStr (map snd cNamePairs) <> ")" - where - colNamesStr cNames = Text.concat (intersperse ", " cNames) + "FOREIGN KEY (" <> colNamesString (map fst cNamePairs) <> ") REFERENCES " + <> oTableName <> " (" <> colNamesString (map snd cNamePairs) <> ")" tableDefnSQL :: Table -> [Text] tableDefnSQL Table {..} = @@ -37,3 +41,14 @@ tableDefnSQL Table {..} = tableSQL = "CREATE TABLE " <> tableName <> " (\n" <> (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