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.
pull/1/head
Abhinav Sarkar 7 years ago
parent 6d8e32950f
commit 6e1341b52a
3 changed files with 96 additions and 68 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 62
      src/Ringo/Extractor.hs
  2. 73
      src/Ringo/Extractor/Internal.hs
  3. 29
      src/Ringo/Generator.hs

62
src/Ringo/Extractor.hs
Unescape 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
Unescape 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
Unescape 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

Write Preview
Loading…
Cancel
Save