abhin4v/ringo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adds dimension table insert SQL generation.

Browse Source 
Moves some private functions from Extractor to Extractor.Internal for reuse.
This commit is contained in:
Abhinav Sarkar 2015-12-15 18:22:51 +05:30
parent 6d8e32950f
commit 6e1341b52a
3 changed files with 96 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
src/Ringo/Extractor.hs
View File

@ -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

73
src/Ringo/Extractor/Internal.hs Normal file
View File

@ -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

29
src/Ringo/Generator.hs
View File

@ -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