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